home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpc09905c.lha / fpc / units / objects.pp < prev    next >
Text File  |  1998-09-21  |  138KB  |  2,755 lines
  1. {
  2.   $Id: objects.pp,v 1.7 1998/07/15 12:08:33 carl Exp $
  3. }
  4. {************[ SOURCE FILE OF FREE VISION ]****************}
  5. {                                                          }
  6. {    System independent clone of objects.pas               }
  7. {                                                          }
  8. {    Interface Copyright (c) 1992 Borland International    }
  9. {                                                          }
  10. {    Parts Copyright (c) 1992,96 by Florian Klaempfl       }
  11. {    fnklaemp@cip.ft.uni-erlangen.de                       }
  12. {                                                          }
  13. {    Parts Copyright (c) 1996 by Frank ZAGO                }
  14. {    zago@ecoledoc.ipc.fr                                  }
  15. {                                                          }
  16. {    Parts Copyright (c) 1995 by MH Spiegel                }
  17. {                                                          }
  18. {    Parts Copyright (c) 1996, 1997 by Leon de Boer        }
  19. {    ldeboer@ibm.net                                       }
  20. {                                                          }
  21. {    Free Vision project coordinator Balazs Scheidler      }
  22. {    bazsi@tas.vein.hu                                     }
  23. {                                                          }
  24. {    Download FV at ftp site                               }
  25. {    ftp://ftp.tolna.hungary.net/pub/fpk-pascal            }
  26. {                                                          }
  27. {****************[ THIS CODE IS FREEWARE ]*****************}
  28. {                                                          }
  29. {     This sourcecode is released for the purpose to       }
  30. {   promote the pascal language on all platforms. You may  }
  31. {   redistribute it and/or modify with the following       }
  32. {   DISCLAIMER.                                            }
  33. {                                                          }
  34. {     This sourcecode is distributed "AS IS" without       }
  35. {   warranty, express, implied or statutory, including     }
  36. {   but not limited to any implied warranties of any       }
  37. {   merchantability and fitness for a particular purpose.  }
  38. {   In no event shall anyone involved with the creation    }
  39. {   and production of this product be liable for indirect, }
  40. {   special, or consequential damages, arising out of any  }
  41. {   use thereof or breach of any warranty.                 }
  42. {                                                          }
  43. {**********************************************************}
  44.  
  45. {*****************[ SUPPORTED PLATFORMS ]******************}
  46. {    16 and 32 Bit compilers                               }
  47. {       DOS      - Turbo Pascal 7.0 +      (16 Bit)        }
  48. {                - FPK Pascal 0.92 +       (32 Bit)        }
  49. {       DPMI     - Turbo Pascal 7.0 +      (16 Bit)        }
  50. {       WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)        }
  51. {       WIN95    - Turbo Pascal 7.0 +      (16 Bit)        }
  52. {       OS2      - Virtual Pascal 0.3 +    (32 Bit)        }
  53. {                - C'T patch to BP         (16 Bit)        }
  54. {                                                          }
  55. {******************[ REVISION HISTORY ]********************}
  56. {  Version  Date        Fix                                }
  57. {  -------  ---------   ---------------------------------  }
  58. {  1.00     12 Jun 96   First multi platform release       }
  59. {  1.01     20 Jun 96   Fixes to TCollection               }
  60. {  1.02     07 Aug 96   Fix TStringCollection.Compare      }
  61. {  1.10     18 Jul 97   Windows 95 support added.          }
  62. {  1.11     21 Aug 97   FPK pascal 0.92 implemented        }
  63. {  1.15     26 Aug 97   TXMSStream compatability added     }
  64. {                       TEMSStream compatability added     }
  65. {  1.30     29 Aug 97   Platform.inc sort added.           }
  66. {  1.32     02 Sep 97   RegisterTypes completed.           }
  67. {  1.37     04 Sep 97   TStream.Get & Put completed.       }
  68. {  1.40     04 Sep 97   LongMul & LongDiv added.           }
  69. {  1.45     04 Sep 97   Refined and passed all tests.      }
  70. {                       FPK - bug on register records!     }
  71. {  1.50     05 May 98   Fixed DOS Access to files, one     }
  72. {                       version for all intel platforms    }
  73. {                       (CEC)                              }
  74. {**********************************************************}
  75. { STLL LEFT TO DO:                                         }
  76. {   -> Port TResourceFile.Init to non-dos systems          }
  77. {   -> fix problem with Constant Registries                }
  78. {**********************************************************}
  79. UNIT Objects;
  80.  
  81. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  82.                                   INTERFACE
  83. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  84.  
  85. {====Include file to sort compiler platform out =====================}
  86. {$I platform.inc}
  87. {====================================================================}
  88.  
  89.  
  90. {==== Compiler directives ===========================================}
  91. {$IFNDEF FPC}
  92. { FPC doesn't support these switches in 0.99.5 }
  93.   {$F+} { Force far calls }
  94.   {$A+} { Word Align Data }
  95.   {$B-} { Allow short circuit boolean evaluations }
  96. {$ENDIF}
  97.  
  98. {$E+} {  Emulation is on }
  99. {$X+} { Extended syntax is ok }
  100. {$R-} { Disable range checking }
  101. {$S-} { Disable Stack Checking }
  102. {$I-} { Disable IO Checking }
  103. {$Q-} { Disable Overflow Checking }
  104. {$V-} { Turn off strict VAR strings }
  105. {====================================================================}
  106.  
  107. {***************************************************************************}
  108. {                             PUBLIC CONSTANTS                              }
  109. {***************************************************************************}
  110.  
  111. {---------------------------------------------------------------------------}
  112. {                          STREAM ERROR STATE MASKS                         }
  113. {---------------------------------------------------------------------------}
  114. CONST
  115.    stOk         =  0;                                 { No stream error }
  116.    stError      = -1;                                 { Access error }
  117.    stInitError  = -2;                                 { Initialize error }
  118.    stReadError  = -3;                                 { Stream read error }
  119.    stWriteError = -4;                                 { Stream write error }
  120.    stGetError   = -5;                                 { Get object error }
  121.    stPutError   = -6;                                 { Put object error }
  122.    stSeekError  = -7;                                 { Seek error in stream }
  123.    stOpenError  = -8;                                 { Error opening stream }
  124.  
  125. {---------------------------------------------------------------------------}
  126. {                        STREAM ACCESS MODE CONSTANTS                       }
  127. {---------------------------------------------------------------------------}
  128. CONST
  129.    stCreate    = $3C00;                               { Create new file }
  130.    stOpenRead  = $3D00;                               { Read access only }
  131.    stOpenWrite = $3D01;                               { Write access only }
  132.    stOpen      = $3D02;                               { Read/write access }
  133.  
  134. {---------------------------------------------------------------------------}
  135. {                          TCollection ERROR CODES                          }
  136. {---------------------------------------------------------------------------}
  137. CONST
  138.    coIndexError = -1;                                 { Index out of range }
  139.    coOverflow   = -2;                                 { Overflow }
  140.  
  141. {---------------------------------------------------------------------------}
  142. {         VMT HEADER CONSTANT - HOPEFULLY WE CAN DROP THIS LATER            }
  143. {---------------------------------------------------------------------------}
  144. CONST
  145.    vmtHeaderSize = 8;                                 { VMT header size }
  146.  
  147. CONST
  148. {---------------------------------------------------------------------------}
  149. {                            MAXIUM DATA SIZES                              }
  150. {---------------------------------------------------------------------------}
  151. {$IFDEF FPC}
  152.    MaxBytes = 128*1024*1024;                          { Maximum data size }
  153. {$ELSE}
  154.    MaxBytes = 16384;
  155. {$ENDIF}
  156.    MaxWords = MaxBytes DIV SizeOf(Word);              { Max word data size }
  157.    MaxPtrs = MaxBytes DIV SizeOf(Pointer);            { Max ptr data size }
  158.    MaxCollectionSize = MaxBytes DIV SizeOf(Pointer);  { Max collection size }
  159.  
  160.  
  161. {***************************************************************************}
  162. {                          PUBLIC TYPE DEFINITIONS                          }
  163. {***************************************************************************}
  164.  
  165. {---------------------------------------------------------------------------}
  166. {                               CHARACTER SET                               }
  167. {---------------------------------------------------------------------------}
  168. TYPE
  169.    TCharSet = SET Of Char;                            { Character set }
  170.    PCharSet = ^TCharSet;                              { Character set ptr }
  171.  
  172. {---------------------------------------------------------------------------}
  173. {                               GENERAL ARRAYS                              }
  174. {---------------------------------------------------------------------------}
  175. TYPE
  176.    TByteArray = ARRAY [0..MaxBytes-1] Of Byte;        { Byte array }
  177.    PByteArray = ^TByteArray;                          { Byte array pointer }
  178.  
  179.    TWordArray = ARRAY [0..MaxWords-1] Of Word;        { Word array }
  180.    PWordArray = ^TWordArray;                          { Word array pointer }
  181.  
  182.    TPointerArray = Array [0..MaxPtrs-1] Of Pointer;   { Pointer array }
  183.    PPointerArray = ^TPointerArray;                    { Pointer array ptr }
  184.  
  185. {---------------------------------------------------------------------------}
  186. {                             POINTER TO STRING                             }
  187. {---------------------------------------------------------------------------}
  188. TYPE
  189.    PString = ^String;                                 { String pointer }
  190.  
  191. {---------------------------------------------------------------------------}
  192. {                            DOS FILENAME STRING                            }
  193. {---------------------------------------------------------------------------}
  194. TYPE
  195. {$IFDEF OS_DOS}                                       { DOS/DPMI DEFINE }
  196.    FNameStr = String[79];                             { DOS filename }
  197. {$ENDIF}
  198. {$IFDEF OS_WINDOWS}                                   { WINDOWS DEFINE }
  199.    FNameStr = String;                                 { Windows filename }
  200. {$ENDIF}
  201. {$IFDEF OS_OS2}                                       { OS2 DEFINE }
  202.    FNameStr = String;                                 { OS2 filename }
  203. {$ENDIF}
  204. {$IFDEF OS_LINUX}
  205.    FNameStr = String;                                 { OS2 filename }
  206. {$ENDIF}
  207. {$IFDEF OS_AMIGA}
  208.    FNameStr = String;
  209. {$ENDIF}
  210. {$IFDEF OS_ATARI}
  211.    FNameStr = String[79];                             { DOS filename }
  212. {$ENDIF}
  213. {$IFDEF OS_MAC}
  214.     FNameStr = String;
  215. {$ENDIF}
  216.  
  217. {---------------------------------------------------------------------------}
  218. {                                 HANDLE SIZE                               }
  219. {---------------------------------------------------------------------------}
  220.  
  221. {$IFDEF OS_DOS}
  222.    THandle = Integer;
  223. {$ENDIF}
  224. {$IFDEF OS_ATARI}
  225.    THandle = Integer;
  226. {$ENDIF}
  227. {$IFDEF OS_LINUX}
  228.  { values are words, though the OS calls return 32-bit values }
  229.  { to check (CEC)                                             }
  230.   THandle = Longint;
  231. {$ENDIF}
  232. {$IFDEF OS_AMIGA}
  233.   THandle = Longint;
  234. {$ENDIF}
  235. {$IFDEF OS_WINDOWS}
  236.   THandle = Longint;
  237. {$ENDIF}
  238. {$IFDEF OS_OS2}
  239.   THandle = Word;
  240. {$ENDIF}
  241. {$IFDEF OS_MAC}
  242.   ???????
  243. {$ENDIF}
  244.  
  245.  
  246. {---------------------------------------------------------------------------}
  247. {                            DOS ASCIIZ FILENAME                            }
  248. {---------------------------------------------------------------------------}
  249. TYPE
  250.    AsciiZ = Array [0..255] Of Char;                   { Filename array }
  251.  
  252. {---------------------------------------------------------------------------}
  253. {                        BIT SWITCHED TYPE CONSTANTS                        }
  254. {---------------------------------------------------------------------------}
  255. TYPE
  256.    Sw_Word    = LongInt;                              { Long integer now }
  257.    Sw_Integer = LongInt;                              { Long integer now }
  258.  
  259. {---------------------------------------------------------------------------}
  260. {                          FUNCTION POINTER DEFINED                         }
  261. {---------------------------------------------------------------------------}
  262. TYPE
  263.    FuncPtr = FUNCTION (Item: Pointer; _EBP: Sw_Word): Boolean;
  264.  
  265. {---------------------------------------------------------------------------}
  266. {                         PROCEDURE POINTER DEFINED                         }
  267. {---------------------------------------------------------------------------}
  268. TYPE
  269.    ProcPtr = PROCEDURE (Item: Pointer; _EBP: Sw_Word);
  270.  
  271. {***************************************************************************}
  272. {                        PUBLIC RECORD DEFINITIONS                          }
  273. {***************************************************************************}
  274.  
  275. {---------------------------------------------------------------------------}
  276. {                          TYPE CONVERSION RECORDS                          }
  277. {---------------------------------------------------------------------------}
  278. TYPE
  279.    WordRec = RECORD
  280.      Lo, Hi: Byte;                                    { Word to bytes }
  281.    END;
  282.  
  283.    LongRec = RECORD
  284.      Lo, Hi: Word;                                    { LongInt to words }
  285.    END;
  286.  
  287.    PtrRec = RECORD
  288.      Ofs, Seg: Word;                                  { Pointer to words }
  289.    END;
  290.  
  291. {---------------------------------------------------------------------------}
  292. {                  TStreamRec RECORD - STREAM OBJECT RECORD                 }
  293. {---------------------------------------------------------------------------}
  294. TYPE
  295.    PStreamRec = ^TStreamRec;                          { Stream record ptr }
  296.    TStreamRec = RECORD
  297.       ObjType: Sw_Word;                               { Object type id }
  298.       VmtLink: Sw_Word;                               { VMT link }
  299.       Load : Pointer;                                 { Object load code }
  300.       Store: Pointer;                                 { Object store code }
  301.       Next : PStreamRec;                              { Next stream record }
  302.    END;
  303.  
  304. {***************************************************************************}
  305. {                        PUBLIC OBJECT DEFINITIONS                          }
  306. {***************************************************************************}
  307.  
  308. {---------------------------------------------------------------------------}
  309. {                        TPoint OBJECT - POINT OBJECT                       }
  310. {---------------------------------------------------------------------------}
  311. TYPE
  312.    TPoint = OBJECT
  313.       X, Y: Integer;
  314.    END;
  315.  
  316. {---------------------------------------------------------------------------}
  317. {                      TRect OBJECT - RECTANGLE OBJECT                      }
  318. {---------------------------------------------------------------------------}
  319.    TRect = OBJECT
  320.          A, B: TPoint;                                { Corner points }
  321.       FUNCTION Empty: Boolean;
  322.       FUNCTION Equals (R: TRect): Boolean;
  323.       FUNCTION Contains (P: TPoint): Boolean;
  324.       PROCEDURE Copy (R: TRect);
  325.       PROCEDURE Union (R: TRect);
  326.       PROCEDURE Intersect (R: TRect);
  327.       PROCEDURE Move (ADX, ADY: Integer);
  328.       PROCEDURE Grow (ADX, ADY: Integer);
  329.       PROCEDURE Assign (XA, YA, XB, YB: Integer);
  330.    END;
  331.  
  332. {---------------------------------------------------------------------------}
  333. {                  TObject OBJECT - BASE ANCESTOR OBJECT                    }
  334. {---------------------------------------------------------------------------}
  335. TYPE
  336.    TObject = OBJECT
  337.       CONSTRUCTOR Init;
  338.       PROCEDURE Free;
  339.       DESTRUCTOR Done;                                               Virtual;
  340.    END;
  341.    PObject = ^TObject;
  342.  
  343. { ******************************* REMARK ****************************** }
  344. {  Two new virtual methods have been added to the object in the form of }
  345. {  Close and Open. The main use here is in the Disk Based Descendants   }
  346. {  the calls open and close the given file so these objects can be      }
  347. {  used like standard files. Two new fields have also been added to     }
  348. {  speed up seeks on descendants. All existing code will compile and    }
  349. {  work completely normally oblivious to these new methods and fields.  }
  350. { ****************************** END REMARK *** Leon de Boer, 15May96 * }
  351.  
  352. {---------------------------------------------------------------------------}
  353. {                 TStream OBJECT - STREAM ANCESTOR OBJECT                   }
  354. {---------------------------------------------------------------------------}
  355. TYPE
  356.    TStream = OBJECT (TObject)
  357.          Status    : Integer;                         { Stream status }
  358.          ErrorInfo : Integer;                         { Stream error info }
  359.          StreamSize: LongInt;                         { Stream current size }
  360.          Position  : LongInt;                         { Current position }
  361.       FUNCTION Get: PObject;
  362.       FUNCTION StrRead: PChar;
  363.       FUNCTION GetPos: Longint;                                      Virtual;
  364.       FUNCTION GetSize: Longint;                                     Virtual;
  365.       FUNCTION ReadStr: PString;
  366.       PROCEDURE Open (OpenMode: Word);                               Virtual;
  367.       PROCEDURE Close;                                               Virtual;
  368.       PROCEDURE Reset;
  369.       PROCEDURE Flush;                                               Virtual;
  370.       PROCEDURE Truncate;                                            Virtual;
  371.       PROCEDURE Put (P: PObject);
  372.       PROCEDURE StrWrite (P: PChar);
  373.       PROCEDURE WriteStr (P: PString);
  374.       PROCEDURE Seek (Pos: LongInt);                                 Virtual;
  375.       PROCEDURE Error (Code, Info: Integer);                         Virtual;
  376.       PROCEDURE Read (Var Buf; Count: Sw_Word);                      Virtual;
  377.       PROCEDURE Write (Var Buf; Count: Sw_Word);                     Virtual;
  378.       PROCEDURE CopyFrom (Var S: TStream; Count: Longint);
  379.    END;
  380.    PStream = ^TStream;
  381.  
  382. { ******************************* REMARK ****************************** }
  383. {   A few minor changes to this object and an extra field added called  }
  384. {  FName which holds an AsciiZ array of the filename this allows the    }
  385. {  streams file to be opened and closed like a normal text file. All    }
  386. {  existing code should work without any changes.                       }
  387. { ****************************** END REMARK *** Leon de Boer, 19May96 * }
  388.  
  389. {---------------------------------------------------------------------------}
  390. {                TDosStream OBJECT - DOS FILE STREAM OBJECT                 }
  391. {---------------------------------------------------------------------------}
  392. TYPE
  393.    TDosStream = OBJECT (TStream)
  394.          Handle: THandle;                             { DOS file handle }
  395.          FName : AsciiZ;                              { AsciiZ filename }
  396.       CONSTRUCTOR Init (FileName: FNameStr; Mode: Word);
  397.       DESTRUCTOR Done;                                               Virtual;
  398.       PROCEDURE Close;                                               Virtual;
  399.       PROCEDURE Truncate;                                            Virtual;
  400.       PROCEDURE Seek (Pos: LongInt);                                 Virtual;
  401.       PROCEDURE Open (OpenMode: Word);                               Virtual;
  402.       PROCEDURE Read (Var Buf; Count: Sw_Word);                      Virtual;
  403.       PROCEDURE Write (Var Buf; Count: Sw_Word);                     Virtual;
  404.    END;
  405.    PDosStream = ^TDosStream;
  406.  
  407. { ******************************* REMARK ****************************** }
  408. {   A few minor changes to this object and an extra field added called  }
  409. {  lastmode which holds the read or write condition last using the      }
  410. {  speed up buffer which helps speed up the flush, position and size    }
  411. {  functions. All existing code should work without any changes.        }
  412. { ****************************** END REMARK *** Leon de Boer, 19May96 * }
  413.  
  414. {---------------------------------------------------------------------------}
  415. {                TBufStream OBJECT - BUFFERED DOS FILE STREAM               }
  416. {---------------------------------------------------------------------------}
  417. TYPE
  418.    TBufStream = OBJECT (TDosStream)
  419.          LastMode: Byte;                              { Last buffer mode }
  420.          BufSize : Sw_Word;                           { Buffer size }
  421.          BufPtr  : Sw_Word;                           { Buffer start }
  422.          BufEnd  : Sw_Word;                           { Buffer end }
  423.          Buffer  : PByteArray;                        { Buffer allocated }
  424.       CONSTRUCTOR Init (FileName: FNameStr; Mode, Size: Word);
  425.       DESTRUCTOR Done;                                               Virtual;
  426.       PROCEDURE Close;                                               Virtual;
  427.       PROCEDURE Flush;                                               Virtual;
  428.       PROCEDURE Truncate;                                            Virtual;
  429.       PROCEDURE Seek (Pos: LongInt);                                 Virtual;
  430.       PROCEDURE Open (OpenMode: Word);                               Virtual;
  431.       PROCEDURE Read (Var Buf; Count: Sw_Word);                      Virtual;
  432.       PROCEDURE Write (Var Buf; Count: Sw_Word);                     Virtual;
  433.    END;
  434.    PBufStream = ^TBufStream;
  435.  
  436. { ******************************* REMARK ****************************** }
  437. {  All the changes here should be completely transparent to existing    }
  438. {  code. Basically the memory blocks do not have to be base segments    }
  439. {  but this means our list becomes memory blocks rather than segments.  }
  440. {  The stream will also expand like the other standard streams!!        }
  441. { ****************************** END REMARK *** Leon de Boer, 19May96 * }
  442.  
  443. {---------------------------------------------------------------------------}
  444. {               TMemoryStream OBJECT - MEMORY STREAM OBJECT                 }
  445. {---------------------------------------------------------------------------}
  446. TYPE
  447.    TMemoryStream = OBJECT (TStream)
  448.          BlkCount: Sw_Word;                           { Number of segments }
  449.          BlkSize : Word;                              { Memory block size }
  450.          MemSize : LongInt;                           { Memory alloc size }
  451.          BlkList : PPointerArray;                     { Memory block list }
  452.       CONSTRUCTOR Init (ALimit: Longint; ABlockSize: Word);
  453.       DESTRUCTOR Done;                                               Virtual;
  454.       PROCEDURE Truncate;                                            Virtual;
  455.       PROCEDURE Read (Var Buf; Count: Sw_Word);                      Virtual;
  456.       PROCEDURE Write (Var Buf; Count: Sw_Word);                     Virtual;
  457.       PRIVATE
  458.       FUNCTION ChangeListSize (ALimit: Sw_Word): Boolean;
  459.    END;
  460.    PMemoryStream = ^TMemoryStream;
  461.  
  462.  
  463. TYPE
  464.   TItemList = Array [0..MaxCollectionSize - 1] Of Pointer;
  465.   PItemList = ^TItemList;
  466.  
  467. { ******************************* REMARK ****************************** }
  468. {    The changes here look worse than they are. The Sw_Integer simply   }
  469. {  switches between Integers and LongInts if switched between 16 and 32 }
  470. {  bit code. All existing code will compile without any changes.        }
  471. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  472.  
  473. {---------------------------------------------------------------------------}
  474. {              TCollection OBJECT - COLLECTION ANCESTOR OBJECT              }
  475. {---------------------------------------------------------------------------}
  476.    TCollection = OBJECT (TObject)
  477.          Items: PItemList;                            { Item list pointer }
  478.          Count: Sw_Integer;                           { Item count }
  479.          Limit: Sw_Integer;                           { Item limit count }
  480.          Delta: Sw_Integer;                           { Inc delta size }
  481.       CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
  482.       CONSTRUCTOR Load (Var S: TStream);
  483.       DESTRUCTOR Done;                                               Virtual;
  484.       FUNCTION At (Index: Sw_Integer): Pointer;
  485.       FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
  486.       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
  487.       FUNCTION LastThat (Test: Pointer): Pointer;
  488.       FUNCTION FirstThat (Test: Pointer): Pointer;
  489.       PROCEDURE Pack;
  490.       PROCEDURE FreeAll;
  491.       PROCEDURE DeleteAll;
  492.       PROCEDURE Free (Item: Pointer);
  493.       PROCEDURE Insert (Item: Pointer);                              Virtual;
  494.       PROCEDURE Delete (Item: Pointer);
  495.       PROCEDURE AtFree (Index: Sw_Integer);
  496.       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
  497.       PROCEDURE AtDelete (Index: Sw_Integer);
  498.       PROCEDURE ForEach (Action: Pointer);
  499.       PROCEDURE SetLimit (ALimit: Sw_Integer);                       Virtual;
  500.       PROCEDURE Error (Code, Info: Integer);                         Virtual;
  501.       PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
  502.       PROCEDURE AtInsert (Index: Sw_Integer; Item: Pointer);
  503.       PROCEDURE Store (Var S: TStream);
  504.       PROCEDURE PutItem (Var S: TStream; Item: Pointer);             Virtual;
  505.    END;
  506.    PCollection = ^TCollection;
  507.  
  508. {---------------------------------------------------------------------------}
  509. {          TSortedCollection OBJECT - SORTED COLLECTION ANCESTOR            }
  510. {---------------------------------------------------------------------------}
  511. TYPE
  512.    TSortedCollection = OBJECT (TCollection)
  513.          Duplicates: Boolean;                         { Duplicates flag }
  514.       CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
  515.       CONSTRUCTOR Load (Var S: TStream);
  516.       FUNCTION KeyOf (Item: Pointer): Pointer;                       Virtual;
  517.       FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
  518.       FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer;            Virtual;
  519.       FUNCTION Search (Key: Pointer; Var Index: Sw_Integer): Boolean;Virtual;
  520.       PROCEDURE Insert (Item: Pointer);                              Virtual;
  521.       PROCEDURE Store (Var S: TStream);
  522.    END;
  523.    PSortedCollection = ^TSortedCollection;
  524.  
  525. {---------------------------------------------------------------------------}
  526. {           TStringCollection OBJECT - STRING COLLECTION OBJECT             }
  527. {---------------------------------------------------------------------------}
  528. TYPE
  529.    TStringCollection = OBJECT (TSortedCollection)
  530.       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
  531.       FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer;            Virtual;
  532.       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
  533.       PROCEDURE PutItem (Var S: TStream; Item: Pointer);             Virtual;
  534.    END;
  535.    PStringCollection = ^TStringCollection;
  536.  
  537. {---------------------------------------------------------------------------}
  538. {             TStrCollection OBJECT - STRING COLLECTION OBJECT              }
  539. {---------------------------------------------------------------------------}
  540. TYPE
  541.    TStrCollection = OBJECT (TSortedCollection)
  542.       FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer;            Virtual;
  543.       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
  544.       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
  545.       PROCEDURE PutItem (Var S: TStream; Item: Pointer);             Virtual;
  546.    END;
  547.    PStrCollection = ^TStrCollection;
  548.  
  549. { ******************************* REMARK ****************************** }
  550. {    This is a completely >> NEW << object which holds a collection of  }
  551. {  strings but does not alphabetically sort them. It is a very useful   }
  552. {  object for insert ordered list boxes!                                }
  553. { ****************************** END REMARK *** Leon de Boer, 15May96 * }
  554.  
  555. {---------------------------------------------------------------------------}
  556. {        TUnSortedStrCollection - UNSORTED STRING COLLECTION OBJECT         }
  557. {---------------------------------------------------------------------------}
  558. TYPE
  559.    TUnSortedStrCollection = OBJECT (TStringCollection)
  560.       PROCEDURE Insert (Item: Pointer);                              Virtual;
  561.    END;
  562.    PUnSortedStrCollection = ^TUnSortedStrCollection;
  563.  
  564. {---------------------------------------------------------------------------}
  565. {         TResourceCollection OBJECT - RESOURCE COLLECTION OBJECT           }
  566. {---------------------------------------------------------------------------}
  567. TYPE
  568.    TResourceCollection = OBJECT (TStringCollection)
  569.       FUNCTION KeyOf (Item: Pointer): Pointer;                       Virtual;
  570.       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
  571.       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
  572.       PROCEDURE PutItem (Var S: TStream; Item: Pointer);             Virtual;
  573.    END;
  574.    PResourceCollection = ^TResourceCollection;
  575.  
  576. {---------------------------------------------------------------------------}
  577. {                 TResourceFile OBJECT - RESOURCE FILE OBJECT               }
  578. {---------------------------------------------------------------------------}
  579. TYPE
  580.    TResourceFile = OBJECT (TObject)
  581.          Stream  : PStream;                           { File as a stream }
  582.          Modified: Boolean;                           { Modified flag }
  583.       CONSTRUCTOR Init (AStream: PStream);
  584.       DESTRUCTOR Done;                                               Virtual;
  585.       FUNCTION Count: Sw_Integer;
  586.       FUNCTION KeyAt (I: Sw_Integer): String;
  587.       FUNCTION Get (Key: String): PObject;
  588.       FUNCTION SwitchTo (AStream: PStream; Pack: Boolean): PStream;
  589.       PROCEDURE Flush;
  590.       PROCEDURE Delete (Key: String);
  591.       PROCEDURE Put (Item: PObject; Key: String);
  592.       PRIVATE
  593.          BasePos: LongInt;                            { Base position }
  594.          IndexPos: LongInt;                           { Index position }
  595.          Index: TResourceCollection;                  { Index collection }
  596.    END;
  597.    PResourceFile = ^TResourceFile;
  598.  
  599. TYPE
  600.    TStrIndexRec = RECORD Key, Count, Offset: Word; END;
  601.  
  602.    TStrIndex = Array [0..9999] Of TStrIndexRec;
  603.    PStrIndex = ^TStrIndex;
  604.  
  605. {---------------------------------------------------------------------------}
  606. {                 TStringList OBJECT - STRING LIST OBJECT                   }
  607. {---------------------------------------------------------------------------}
  608.    TStringList = OBJECT (TObject)
  609.       CONSTRUCTOR Load (Var S: TStream);
  610.       DESTRUCTOR Done;                                               Virtual;
  611.       FUNCTION Get (Key: Sw_Word): String;
  612.       PRIVATE
  613.          Stream   : PStream;
  614.          BasePos  : Longint;
  615.          IndexSize: Sw_Word;
  616.          Index    : PStrIndex;
  617.       PROCEDURE ReadStr (Var S: String; Offset, Skip: Sw_Word);
  618.    END;
  619.    PStringList = ^TStringList;
  620.  
  621. {---------------------------------------------------------------------------}
  622. {                 TStrListMaker OBJECT - RESOURCE FILE OBJECT               }
  623. {---------------------------------------------------------------------------}
  624. TYPE
  625.    TStrListMaker = OBJECT (TObject)
  626.       CONSTRUCTOR Init (AStrSize, AIndexSize: Sw_Word);
  627.       DESTRUCTOR Done;                                               Virtual;
  628.       PROCEDURE Put (Key: Sw_Word; S: String);
  629.       PROCEDURE Store (Var S: TStream);
  630.       PRIVATE
  631.          StrPos   : Sw_Word;
  632.          StrSize  : Sw_Word;
  633.          Strings  : PByteArray;
  634.          IndexPos : Sw_Word;
  635.          IndexSize: Sw_Word;
  636.          Index    : PStrIndex;
  637.          Cur      : TStrIndexRec;
  638.       PROCEDURE CloseCurrent;
  639.    END;
  640.    PStrListMaker = ^TStrListMaker;
  641.  
  642. {***************************************************************************}
  643. {                            INTERFACE ROUTINES                             }
  644. {***************************************************************************}
  645.  
  646. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  647. {                    DYNAMIC STRING INTERFACE ROUTINES                      }
  648. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  649.  
  650. {-NewStr-------------------------------------------------------------
  651. Allocates a dynamic string into memory. If S is nil, NewStr returns
  652. a nil pointer, otherwise NewStr allocates Length(S)+1 bytes of memory
  653. containing a copy of S, and returns a pointer to the string.
  654. 12Jun96 LdB
  655. ---------------------------------------------------------------------}
  656. FUNCTION NewStr (Const S: String): PString;
  657.  
  658. {-DisposeStr---------------------------------------------------------
  659. Disposes of a PString allocated by the function NewStr.
  660. 12Jun96 LdB
  661. ---------------------------------------------------------------------}
  662. PROCEDURE DisposeStr (P: PString);
  663.  
  664. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  665. {                        STREAM INTERFACE ROUTINES                          }
  666. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  667.  
  668. {-Abstract-----------------------------------------------------------
  669. Terminates program with a run-time error 211. When implementing
  670. an abstract object type, call Abstract in those virtual methods that
  671. must be overridden in descendant types. This ensures that any
  672. attempt to use instances of the abstract object type will fail.
  673. 12Jun96 LdB
  674. ---------------------------------------------------------------------}
  675. PROCEDURE Abstract;
  676.  
  677. {-RegisterObjects----------------------------------------------------
  678. Registers the three standard objects TCollection, TStringCollection
  679. and TStrCollection.
  680. 02Sep97 LdB
  681. ---------------------------------------------------------------------}
  682. PROCEDURE RegisterObjects;
  683.  
  684. {-RegisterType-------------------------------------------------------
  685. Registers the given object type with Free Vision's streams, creating
  686. a list of known objects. Streams can only store and return these known
  687. object types. Each registered object needs a unique stream registration
  688. record, of type TStreamRec.
  689. 02Sep97 LdB
  690. ---------------------------------------------------------------------}
  691. PROCEDURE RegisterType (Var S: TStreamRec);
  692.  
  693. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  694. {                    GENERAL FUNCTION INTERFACE ROUTINES                    }
  695. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  696.  
  697. {-LongMul------------------------------------------------------------
  698. Returns the long integer value of X * Y integer values.
  699. 04Sep97 LdB
  700. ---------------------------------------------------------------------}
  701. FUNCTION LongMul (X, Y: Integer): LongInt;
  702.  
  703. {-LongDiv------------------------------------------------------------
  704. Returns the integer value of long integer X divided by integer Y.
  705. 04Sep97 LdB
  706. ---------------------------------------------------------------------}
  707. FUNCTION LongDiv (X: Longint; Y: Integer): Integer;
  708.  
  709.  
  710. {***************************************************************************}
  711. {                         PUBLIC INITIALIZED VARIABLES                      }
  712. {***************************************************************************}
  713.  
  714.  
  715. CONST
  716. {---------------------------------------------------------------------------}
  717. {              INITIALIZED DOS/DPMI/WIN/OS2 PUBLIC VARIABLES                }
  718. {---------------------------------------------------------------------------}
  719.    StreamError: Pointer = Nil;                        { Stream error ptr }
  720.    DosStreamError: Word = $0;                      { Dos stream error }
  721.  
  722. { ******************************* REMARK ****************************** }
  723. {    FPK 0.92 compiler wont handle this section OFS seems not to be a   }
  724. {  defined function which we need -> Function Ofs(X): LongInt; So for   }
  725. {  now we must exclude these and in the RegisterObjects code.           }
  726. { ****************************** END REMARK *** Leon de Boer, 04Sep97 * }
  727. {---------------------------------------------------------------------------}
  728. {                        STREAM REGISTRATION RECORDS                        }
  729. {---------------------------------------------------------------------------}
  730. (*
  731. CONST
  732.    RCollection: TStreamRec = (
  733.      ObjType: 50;
  734.      VmtLink: Ofs(TypeOf(TCollection)^);
  735.      Load: @TCollection.Load;
  736.      Store: @TCollection.Store);
  737.  
  738. CONST
  739.    RStringCollection: TStreamRec = (
  740.      ObjType: 51;
  741.      VmtLink: Ofs(TypeOf(TStringCollection)^);
  742.      Load: @TStringCollection.Load;
  743.      Store: @TStringCollection.Store);
  744.  
  745. CONST
  746.    RStrCollection: TStreamRec = (
  747.      ObjType: 69;
  748.      VmtLink: Ofs(TypeOf(TStrCollection)^);
  749.      Load:    @TStrCollection.Load;
  750.      Store:   @TStrCollection.Store);
  751.  
  752. CONST
  753.    RStringList: TStreamRec = (
  754.      ObjType: 52;
  755.      VmtLink: Ofs(TypeOf(TStringList)^);
  756.      Load: @TStringList.Load;
  757.      Store: Nil);
  758.  
  759. CONST
  760.    RStrListMaker: TStreamRec = (
  761.      ObjType: 52;
  762.      VmtLink: Ofs(TypeOf(TStrListMaker)^);
  763.      Load: Nil;
  764.      Store: @TStrListMaker.Store);
  765. *)
  766. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  767.                                 IMPLEMENTATION
  768. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  769.  
  770.  
  771. {***************************************************************************}
  772. {                      PRIVATE INITIALIZED VARIABLES                        }
  773. {***************************************************************************}
  774.  
  775. {$IFDEF OS_DOS}                                       { DOS CODE }
  776. {---------------------------------------------------------------------------}
  777. {                    INITIALIZED DOS PRIVATE VARIABLES                      }
  778. {---------------------------------------------------------------------------}
  779. CONST
  780.    InitRun: Boolean = False;                          { Init check run }
  781.    Win95  : Boolean = False;                          { If Win 95 active }
  782. {$ENDIF}
  783.  
  784. {---------------------------------------------------------------------------}
  785. {               INITIALIZED DOS/DPMI/WIN/OS2 PRIVATE VARIABLES              }
  786. {---------------------------------------------------------------------------}
  787. CONST
  788.    StreamTypes: PStreamRec = Nil;                     { Stream types reg }
  789.  
  790. {***************************************************************************}
  791. {                          PRIVATE INTERNAL ROUTINES                        }
  792. {***************************************************************************}
  793.  
  794. {$I objinc.inc}
  795.  
  796. {$IFDEF CPU86}
  797. {$I386_ATT}
  798. {$ENDIF}
  799.  
  800. {---------------------------------------------------------------------------}
  801. {  RegisterError -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB    }
  802. {---------------------------------------------------------------------------}
  803. PROCEDURE RegisterError;
  804. BEGIN
  805.    RunError(212);                                     { Register error }
  806. END;
  807.  
  808.  
  809. {***************************************************************************}
  810. {                               OBJECT METHODS                              }
  811. {***************************************************************************}
  812.  
  813. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  814. {                           TRect OBJECT METHODS                            }
  815. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  816. PROCEDURE CheckEmpty (Var Rect: TRect);
  817. BEGIN
  818.    With Rect Do Begin
  819.      If (A.X >= B.X) OR (A.Y >= B.Y) Then Begin       { Zero or reversed }
  820.        A.X := 0;                                      { Clear a.x }
  821.        A.Y := 0;                                      { Clear a.y }
  822.        B.X := 0;                                      { Clear b.x }
  823.        B.Y := 0;                                      { Clear b.y }
  824.      End;
  825.    End;
  826. END;
  827.  
  828. {--TRect--------------------------------------------------------------------}
  829. {  Empty -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  830. {---------------------------------------------------------------------------}
  831. FUNCTION TRect.Empty: Boolean;
  832. BEGIN
  833.    Empty := (A.X >= B.X) OR (A.Y >= B.Y);             { Empty result }
  834. END;
  835.  
  836. {--TRect--------------------------------------------------------------------}
  837. {  Equals -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB               }
  838. {---------------------------------------------------------------------------}
  839. FUNCTION TRect.Equals (R: TRect): Boolean;
  840. BEGIN
  841.    Equals := (A.X = R.A.X) AND (A.Y = R.A.Y) AND
  842.    (B.X = R.B.X) AND (B.Y = R.B.Y);                   { Equals result }
  843. END;
  844.  
  845. {--TRect--------------------------------------------------------------------}
  846. {  Contains -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  847. {---------------------------------------------------------------------------}
  848. FUNCTION TRect.Contains (P: TPoint): Boolean;
  849. BEGIN
  850.    Contains := (P.X >= A.X) AND (P.X < B.X) AND
  851.      (P.Y >= A.Y) AND (P.Y < B.Y);                    { Contains result }
  852. END;
  853.  
  854. {--TRect--------------------------------------------------------------------}
  855. {  Copy -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  856. {---------------------------------------------------------------------------}
  857. PROCEDURE TRect.Copy (R: TRect);
  858. BEGIN
  859.    A := R.A;                                          { Copy point a }
  860.    B := R.B;                                          { Copy point b }
  861. END;
  862.  
  863. {--TRect--------------------------------------------------------------------}
  864. {  Union -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  865. {---------------------------------------------------------------------------}
  866. PROCEDURE TRect.Union (R: TRect);
  867. BEGIN
  868.    If (R.A.X < A.X) Then A.X := R.A.X;                { Take if smaller }
  869.    If (R.A.Y < A.Y) Then A.Y := R.A.Y;                { Take if smaller }
  870.    If (R.B.X > B.X) Then B.X := R.B.X;                { Take if larger }
  871.    If (R.B.Y > B.Y) Then B.Y := R.B.Y;                { Take if larger }
  872. END;
  873.  
  874. {--TRect--------------------------------------------------------------------}
  875. {  Intersect -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB            }
  876. {---------------------------------------------------------------------------}
  877. PROCEDURE TRect.Intersect (R: TRect);
  878. BEGIN
  879.    If (R.A.X > A.X) Then A.X := R.A.X;                { Take if larger }
  880.    If (R.A.Y > A.Y) Then A.Y := R.A.Y;                { Take if larger }
  881.    If (R.B.X < B.X) Then B.X := R.B.X;                { Take if smaller }
  882.    If (R.B.Y < B.Y) Then B.Y := R.B.Y;                { Take if smaller }
  883.    CheckEmpty(Self);                                  { Check if empty }
  884. END;
  885.  
  886. {--TRect--------------------------------------------------------------------}
  887. {  Move -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  888. {---------------------------------------------------------------------------}
  889. PROCEDURE TRect.Move (ADX, ADY: Integer);
  890. BEGIN
  891.    Inc(A.X, ADX);                                     { Adjust A.X }
  892.    Inc(A.Y, ADY);                                     { Adjust A.Y }
  893.    Inc(B.X, ADX);                                     { Adjust B.X }
  894.    Inc(B.Y, ADY);                                     { Adjust B.Y }
  895. END;
  896.  
  897. {--TRect--------------------------------------------------------------------}
  898. {  Grow -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  899. {---------------------------------------------------------------------------}
  900. PROCEDURE TRect.Grow (ADX, ADY: Integer);
  901. BEGIN
  902.    Dec(A.X, ADX);                                     { Adjust A.X }
  903.    Dec(A.Y, ADY);                                     { Adjust A.Y }
  904.    Inc(B.X, ADX);                                     { Adjust B.X }
  905.    Inc(B.Y, ADY);                                     { Adjust B.Y }
  906.    CheckEmpty(Self);                                  { Check if empty }
  907. END;
  908.  
  909. {--TRect--------------------------------------------------------------------}
  910. {  Assign -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB               }
  911. {---------------------------------------------------------------------------}
  912. PROCEDURE TRect.Assign (XA, YA, XB, YB: Integer);
  913. BEGIN
  914.    A.X := XA;                                         { Hold A.X value }
  915.    A.Y := YA;                                         { Hold A.Y value }
  916.    B.X := XB;                                         { Hold B.X value }
  917.    B.Y := YB;                                         { Hold B.Y value }
  918. END;
  919.  
  920. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  921. {                           TObject OBJECT METHODS                          }
  922. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  923.  
  924. TYPE
  925.    DummyObject = OBJECT (TObject)                     { Internal object }
  926.      Data: RECORD END;                                { Helps size VMT link }
  927.    END;
  928.  
  929. { ******************************* REMARK ****************************** }
  930. { I Prefer this code because it self sizes VMT link rather than using a }
  931. { fixed record structure thus it should work on all compilers without a }
  932. { specific record to match each compiler.                               }
  933. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  934.  
  935. {--TObject------------------------------------------------------------------}
  936. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  937. {---------------------------------------------------------------------------}
  938. CONSTRUCTOR TObject.Init;
  939. VAR LinkSize: LongInt; Dummy: DummyObject;
  940. BEGIN
  941.    LinkSize := LongInt(@Dummy.Data)-LongInt(@Dummy);  { Calc VMT link size }
  942.    FillChar(Pointer(LongInt(@Self)+LinkSize)^,
  943.      SizeOf(Self)-LinkSize, #0);                      { Clear data fields }
  944. END;
  945.  
  946. {--TObject------------------------------------------------------------------}
  947. {  Free -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  948. {---------------------------------------------------------------------------}
  949. PROCEDURE TObject.Free;
  950. BEGIN
  951.    Dispose(PObject(@Self), Done);                     { Dispose of self }
  952. END;
  953.  
  954. {--TObject------------------------------------------------------------------}
  955. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  956. {---------------------------------------------------------------------------}
  957. DESTRUCTOR TObject.Done;
  958. BEGIN                                                 { Abstract method }
  959. END;
  960.  
  961. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  962. {                           TStream OBJECT METHODS                          }
  963. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  964.  
  965. {--TStream------------------------------------------------------------------}
  966. {  Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 02Sep97 LdB                  }
  967. {---------------------------------------------------------------------------}
  968. FUNCTION TStream.Get: PObject;
  969.  
  970. TYPE LoadPtr = FUNCTION (Var S: TStream; Link: Sw_Word; Iv: Pointer): PObject;
  971.  
  972. VAR ObjType: Sw_Word; P: PStreamRec;
  973. BEGIN
  974.    Read(ObjType, SizeOf(ObjType));                    { Read object type }
  975.    If (ObjType<>0) Then Begin                         { Object registered }
  976.      P := StreamTypes;                                { Current reg list }
  977.      While (P <> Nil) AND (P^.ObjType <> ObjType)     { Find object type OR }
  978.        Do P := P^.Next;                               { Find end of chain }
  979.      If (P=Nil) Then Begin                            { Not registered }
  980.        Error(stGetError, ObjType);                    { Obj not registered }
  981.        Get := Nil;                                    { Return nil pointer }
  982.      End Else Get := LoadPtr(P^.Load)(Self,
  983.        P^.VMTLink, Nil)                               { Call constructor }
  984.    End Else Get := Nil;                               { Return nil pointer }
  985. END;
  986.  
  987. {--TStream------------------------------------------------------------------}
  988. {  StrRead -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB              }
  989. {---------------------------------------------------------------------------}
  990. FUNCTION TStream.StrRead: PChar;
  991. VAR L: Word; P: PChar;
  992. BEGIN
  993.    Read(L, SizeOf(L));                                { Read length }
  994.    If (L = 0) Then StrRead := Nil Else Begin          { Check for empty }
  995.      GetMem(P, L + 1);                                { Allocate memory }
  996.      If (P <> Nil) Then Begin                         { Check allocate okay }
  997.        Read(P[0], L);                                 { Read the data }
  998.        P[L] := #0;                                    { Terminate with #0 }
  999.      End;
  1000.      StrRead := P;                                    { Return PChar }
  1001.    End;
  1002. END;
  1003.  
  1004. {--TStream------------------------------------------------------------------}
  1005. {  ReadStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB              }
  1006. {---------------------------------------------------------------------------}
  1007. FUNCTION TStream.ReadStr: PString;
  1008. VAR L: Byte; P: PString;
  1009. BEGIN
  1010.    Read(L, 1);                                        { Read string length }
  1011.    If (L > 0) Then Begin
  1012.      GetMem(P, L + 1);                                { Allocate memory }
  1013.      If (P <> Nil) Then Begin                         { Check allocate okay }
  1014.        P^[0] := Char(L);                              { Hold length }
  1015.        Read(P^[1], L);                                { Read string data }
  1016.      End;
  1017.      ReadStr := P;                                    { Return string ptr }
  1018.    End Else ReadStr := Nil;
  1019. END;
  1020.  
  1021. {--TStream------------------------------------------------------------------}
  1022. {  GetPos -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB               }
  1023. {---------------------------------------------------------------------------}
  1024. FUNCTION TStream.GetPos: LongInt;
  1025. BEGIN
  1026.    If (Status=stOk) Then GetPos := Position           { Return position }
  1027.      Else GetPos := -1;                               { Stream in error }
  1028. END;
  1029.  
  1030. {--TStream------------------------------------------------------------------}
  1031. {  GetSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB              }
  1032. {---------------------------------------------------------------------------}
  1033. FUNCTION TStream.GetSize: LongInt;
  1034. BEGIN
  1035.    If (Status=stOk) Then GetSize := StreamSize        { Return stream size }
  1036.      Else GetSize := -1;                              { Stream in error }
  1037. END;
  1038.  
  1039. {--TStream------------------------------------------------------------------}
  1040. {  Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  1041. {---------------------------------------------------------------------------}
  1042. PROCEDURE TStream.Close;
  1043. BEGIN                                                 { Abstract method }
  1044. END;
  1045.  
  1046. {--TStream------------------------------------------------------------------}
  1047. {  Reset -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  1048. {---------------------------------------------------------------------------}
  1049. PROCEDURE TStream.Reset;
  1050. BEGIN
  1051.    Status := 0;                                       { Clear status }
  1052.    ErrorInfo := 0;                                    { Clear error info }
  1053. END;
  1054.  
  1055. {--TStream------------------------------------------------------------------}
  1056. {  Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  1057. {---------------------------------------------------------------------------}
  1058. PROCEDURE TStream.Flush;
  1059. BEGIN                                                 { Abstract method }
  1060. END;
  1061.  
  1062. {--TStream------------------------------------------------------------------}
  1063. {  Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  1064. {---------------------------------------------------------------------------}
  1065. PROCEDURE TStream.Truncate;
  1066. BEGIN
  1067.    Abstract;                                          { Abstract error }
  1068. END;
  1069.  
  1070. {--TStream------------------------------------------------------------------}
  1071. {  Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 02Sep97 LdB                  }
  1072. {---------------------------------------------------------------------------}
  1073. PROCEDURE TStream.Put (P: PObject);
  1074. TYPE StorePtr = PROCEDURE (Var S: TStream; AnObject: PObject);
  1075.  
  1076. VAR ObjType: Sw_Word; Link: Sw_Word; Q: PStreamRec; VmtPtr: ^Sw_Word;
  1077. BEGIN
  1078.    VmtPtr := Pointer(P);                              { Xfer object to ptr }
  1079.    Link := VmtPtr^;                                   { VMT link }
  1080.    ObjType := 0;                                      { Set objtype to zero }
  1081.    If (P<>Nil) AND (Link<>0) Then Begin               { We have a VMT link }
  1082.      Q := StreamTypes;                                { Current reg list }
  1083.      While (Q <> Nil) AND (Q^.VMTLink <> Link)        { Find link match OR }
  1084.        Do Q := Q^.Next;                               { Find end of chain }
  1085.      If (Q=Nil) Then Begin                            { End of chain found }
  1086.        Error(stPutError, 0);                          { Not registered error }
  1087.        Exit;                                          { Now exit }
  1088.      End Else ObjType := Q^.ObjType;                  { Update object type }
  1089.    End;
  1090.    Write(ObjType, SizeOf(ObjType));                   { Write object type }
  1091.    If (ObjType<>0) Then                               { Registered object }
  1092.      StorePtr(Q^.Store)(Self, P);                     { Store object }
  1093. END;
  1094.  
  1095. {--TStream------------------------------------------------------------------}
  1096. {  Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  1097. {---------------------------------------------------------------------------}
  1098. PROCEDURE TStream.Seek (Pos: LongInt);
  1099. BEGIN
  1100.    If (Status = stOk) Then Begin                      { Check status }
  1101.      If (Pos < 0) Then Pos := 0;                      { Remove negatives }
  1102.      If (Pos <= StreamSize) Then Position := Pos      { If valid set pos }
  1103.        Else Error(stSeekError, Pos);                  { Position error }
  1104.    End;
  1105. END;
  1106.  
  1107. {--TStream------------------------------------------------------------------}
  1108. {  StrWrite -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  1109. {---------------------------------------------------------------------------}
  1110. PROCEDURE TStream.StrWrite (P: PChar);
  1111. VAR L: Word; Q: PByteArray;
  1112. BEGIN
  1113.    L := 0;                                            { Preset zero size }
  1114.    Q := PByteArray(P);                                { Transfer type }
  1115.    If (Q <> Nil) Then While (Q^[L] <> 0) Do Inc(L);   { PChar length }
  1116.    Write(L, SizeOf(L));                               { Store length }
  1117.    If (P <> Nil) Then Write(P[0], L);                 { Write data }
  1118. END;
  1119.  
  1120. {--TStream------------------------------------------------------------------}
  1121. {  WriteStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  1122. {---------------------------------------------------------------------------}
  1123. PROCEDURE TStream.WriteStr (P: PString);
  1124. CONST Empty: String[1] = '';
  1125. BEGIN
  1126.    If (P <> Nil) Then Write(P^, Length(P^) + 1)       { Write string }
  1127.      Else Write(Empty, 1);                            { Write empty string }
  1128. END;
  1129.  
  1130. {--TStream------------------------------------------------------------------}
  1131. {  Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  1132. {---------------------------------------------------------------------------}
  1133. PROCEDURE TStream.Open (OpenMode: Word);
  1134. BEGIN                                                 { Abstract method }
  1135. END;
  1136.  
  1137. {--TStream------------------------------------------------------------------}
  1138. {  Error -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  1139. {---------------------------------------------------------------------------}
  1140. PROCEDURE TStream.Error (Code, Info: Integer);
  1141. TYPE TErrorProc = Procedure(Var S: TStream);
  1142. BEGIN
  1143.    Status := Code;                                    { Hold error code }
  1144.    ErrorInfo := Info;                                 { Hold error info }
  1145.    If (StreamError <> Nil) Then
  1146.      TErrorProc(StreamError)(Self);                   { Call error ptr }
  1147. END;
  1148.  
  1149. {--TStream------------------------------------------------------------------}
  1150. {  Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  1151. {---------------------------------------------------------------------------}
  1152. PROCEDURE TStream.Read (Var Buf; Count: Sw_Word);
  1153. BEGIN
  1154.    Abstract;                                          { Abstract error }
  1155. END;
  1156.  
  1157. {--TStream------------------------------------------------------------------}
  1158. {  Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  1159. {---------------------------------------------------------------------------}
  1160. PROCEDURE TStream.Write (Var Buf; Count: Sw_Word);
  1161. BEGIN
  1162.    Abstract;                                          { Abstract error }
  1163. END;
  1164.  
  1165. {--TStream------------------------------------------------------------------}
  1166. {  CopyFrom -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  1167. {---------------------------------------------------------------------------}
  1168. PROCEDURE TStream.CopyFrom (Var S: TStream; Count: Longint);
  1169. VAR W: Word; Buffer: Array[0..1023] of Byte;
  1170. BEGIN
  1171.    While (Count > 0) Do Begin
  1172.      If (Count > SizeOf(Buffer)) Then                 { To much data }
  1173.        W := SizeOf(Buffer) Else W := Count;           { Size to transfer }
  1174.      S.Read(Buffer, W);                               { Read from stream }
  1175.      Write(Buffer, W);                                { Write to stream }
  1176.      Dec(Count, W);                                   { Dec write count }
  1177.    End;
  1178. END;
  1179.  
  1180. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1181. {                         TDosStream OBJECT METHODS                         }
  1182. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1183.  
  1184. {--TDosStream---------------------------------------------------------------}
  1185. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1186. {---------------------------------------------------------------------------}
  1187. CONSTRUCTOR TDosStream.Init (FileName: FNameStr; Mode: Word);
  1188. VAR Success: Integer;
  1189. BEGIN
  1190.    Inherited Init;                                    { Call ancestor }
  1191.    FileName := FileName+#0;                           { Make asciiz }
  1192.    Move(FileName[1], FName, Length(FileName));        { Create asciiz name }
  1193.    Handle := FileOpen(FName, Mode);                   { Open the file }
  1194.    If (Handle <> 0) Then Begin                        { Handle valid }
  1195.      Success := SetFilePos(Handle, 0, 2, StreamSize); { Locate end of file }
  1196.      If (Success = 0) Then
  1197.        Success := SetFilePos(Handle, 0, 0, Position); { Reset to file start }
  1198.    End Else Success := 103;                           { Open file failed }
  1199.    If (Handle = 0) OR (Success <> 0) Then Begin       { Open failed }
  1200.      Handle := -1;                                    { Reset invalid handle }
  1201.      Error(stInitError, Success);                     { Call stream error }
  1202.    End;
  1203. END;
  1204.  
  1205. {--TDosStream---------------------------------------------------------------}
  1206. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1207. {---------------------------------------------------------------------------}
  1208. DESTRUCTOR TDosStream.Done;
  1209. BEGIN
  1210.    If (Handle <> -1) Then FileClose(Handle);          { Close the file }
  1211.    Inherited Done;                                    { Call ancestor }
  1212. END;
  1213.  
  1214. {--TDosStream---------------------------------------------------------------}
  1215. {  Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                }
  1216. {---------------------------------------------------------------------------}
  1217. PROCEDURE TDosStream.Close;
  1218. BEGIN
  1219.    If (Handle <> -1) Then FileClose(Handle);          { Close the file }
  1220.    Position := 0;                                     { Zero the position }
  1221.    Handle := -1;                                      { Handle now invalid }
  1222. END;
  1223.  
  1224. {--TDosStream---------------------------------------------------------------}
  1225. {  Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB             }
  1226. {---------------------------------------------------------------------------}
  1227. PROCEDURE TDosStream.Truncate;
  1228. VAR Success: Integer;
  1229. BEGIN
  1230.    If (Status=stOk) Then Begin                        { Check status okay }
  1231.      Success := SetFileSize(Handle, Position);        { Truncate file }
  1232.      If (Success = 0) Then StreamSize := Position     { Adjust size }
  1233.        Else Error(stError, Success);                  { Identify error }
  1234.    End;
  1235. END;
  1236.  
  1237. {--TDosStream---------------------------------------------------------------}
  1238. {  Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1239. {---------------------------------------------------------------------------}
  1240. PROCEDURE TDosStream.Seek (Pos: LongInt);
  1241. VAR Success: Integer; Li: LongInt;
  1242. BEGIN
  1243.    If (Status=stOk) Then Begin                        { Check status okay }
  1244.      If (Pos < 0) Then Pos := 0;                      { Negatives removed }
  1245.      If (Handle = -1) Then Success := 103 Else        { File not open }
  1246.        Success := SetFilePos(Handle, Pos, 0, Li);     { Set file position }
  1247.      If ((Success = -1) OR (Li <> Pos)) Then Begin    { We have an error }
  1248.        If (Success = -1) Then Error(stSeekError, 0)   { General seek error }
  1249.          Else Error(stSeekError, Success);            { Specific seek error }
  1250.      End Else Position := Li;                         { Adjust position }
  1251.    End;
  1252. END;
  1253.  
  1254. {--TDosStream---------------------------------------------------------------}
  1255. {  Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1256. {---------------------------------------------------------------------------}
  1257. PROCEDURE TDosStream.Open (OpenMode: Word);
  1258. BEGIN
  1259.    If (Status=stOk) Then Begin                        { Check status okay }
  1260.      If (Handle = -1) Then Begin                      { File not open }
  1261.        Handle := FileOpen(FName, OpenMode);           { Open the file }
  1262.        Position := 0;                                 { Reset position }
  1263.        If (Handle=0) Then Begin                       { File open failed }
  1264.          Handle := -1;                                { Reset handle }
  1265.          Error(stOpenError, 103);                     { Call stream error }
  1266.        End;
  1267.      End Else Error(stOpenError, 104);                { File already open }
  1268.    End;
  1269. END;
  1270.  
  1271. {--TDosStream---------------------------------------------------------------}
  1272. {  Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1273. {---------------------------------------------------------------------------}
  1274. PROCEDURE TDosStream.Read (Var Buf; Count: Sw_Word);
  1275. VAR Success: Integer; W, BytesMoved: Sw_Word; P: PByteArray;
  1276. BEGIN
  1277.    If (Position + Count > StreamSize) Then            { Insufficient data }
  1278.      Error(stReadError, 0);                           { Read beyond end!!! }
  1279.    If (Handle = -1) Then Error(stReadError, 103);     { File not open }
  1280.    P := @Buf;                                         { Transfer address }
  1281.    While (Count>0) AND (Status=stOk) Do Begin         { Check status & count }
  1282.      W := Count;                                      { Transfer read size }
  1283.      {$IFNDEF OS_OS2}                                 { DOS/DPMI/WINDOWS }
  1284.      If (Count>$FFFE) Then W := $FFFE;                { Cant read >64K bytes }
  1285.      {$ENDIF}
  1286.      Success := FileRead(Handle, P^, W, BytesMoved);  { Read from file }
  1287.      If ((Success<>0) OR (BytesMoved<>W)) Then Begin  { Error was detected }
  1288.        BytesMoved := 0;                               { Clear bytes moved }
  1289.        If (Success <> 0) Then
  1290.          Error(stReadError, Success)                  { Specific read error }
  1291.          Else Error(stReadError, 0);                  { Non specific error }
  1292.      End;
  1293.      Inc(Position, BytesMoved);                       { Adjust position }
  1294.      P := Pointer(LongInt(P) + BytesMoved);           { Adjust buffer ptr }
  1295.      Dec(Count, BytesMoved);                          { Adjust count left }
  1296.    End;
  1297.    If (Count<>0) Then FillChar(P^, Count, #0);        { Error clear buffer }
  1298. END;
  1299.  
  1300. {--TDosStream---------------------------------------------------------------}
  1301. {  Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                }
  1302. {---------------------------------------------------------------------------}
  1303. PROCEDURE TDosStream.Write (Var Buf; Count: Sw_Word);
  1304. VAR Success: Integer; W, BytesMoved: Sw_Word; P: PByteArray;
  1305. BEGIN
  1306.    If (Handle = -1) Then Error(stWriteError, 103);    { File not open }
  1307.    P := @Buf;                                         { Transfer address }
  1308.    While (Count>0) AND (Status=stOk) Do Begin         { Check status & count }
  1309.      W := Count;                                      { Transfer read size }
  1310.      {$IFNDEF OS_OS2}                                 { DOS/DPMI/WINDOWS }
  1311.      If (Count>$FFFF) Then W := $FFFF;                { Cant read >64K bytes }
  1312.      {$ENDIF}
  1313.      Success := FileWrite(Handle, P^, W, BytesMoved); { Write to file }
  1314.      If ((Success<>0) OR (BytesMoved<>W)) Then Begin  { Error was detected }
  1315.        BytesMoved := 0;                               { Clear bytes moved }
  1316.        If (Success<>0) Then
  1317.          Error(stWriteError, Success)                 { Specific write error }
  1318.          Else Error(stWriteError, 0);                 { Non specific error }
  1319.      End;
  1320.      Inc(Position, BytesMoved);                       { Adjust position }
  1321.      P := Pointer(LongInt(P) + BytesMoved);           { Transfer address }
  1322.      Dec(Count, BytesMoved);                          { Adjust count left }
  1323.      If (Position > StreamSize) Then                  { File expanded }
  1324.        StreamSize := Position;                        { Adjust stream size }
  1325.    End;
  1326. END;
  1327.  
  1328. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1329. {                         TBufStream OBJECT METHODS                         }
  1330. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1331.  
  1332. {--TBufStream---------------------------------------------------------------}
  1333. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                 }
  1334. {---------------------------------------------------------------------------}
  1335. CONSTRUCTOR TBufStream.Init (FileName: FNameStr; Mode, Size: Word);
  1336. BEGIN
  1337.    Inherited Init(FileName, Mode);                    { Call ancestor }
  1338.    BufSize := Size;                                   { Hold buffer size }
  1339.    If (Size<>0) Then GetMem(Buffer, Size);            { Allocate buffer }
  1340.    If (Buffer=Nil) Then Error(stInitError, 0);        { Buffer allocate fail }
  1341. END;
  1342.  
  1343. {--TBufStream---------------------------------------------------------------}
  1344. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                 }
  1345. {---------------------------------------------------------------------------}
  1346. DESTRUCTOR TBufStream.Done;
  1347. BEGIN
  1348.    Flush;                                             { Flush the file }
  1349.    Inherited Done;                                    { Call ancestor }
  1350.    If (Buffer<>Nil) Then FreeMem(Buffer, BufSize);    { Release buffer }
  1351. END;
  1352.  
  1353. {--TBufStream---------------------------------------------------------------}
  1354. {  Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                }
  1355. {---------------------------------------------------------------------------}
  1356. PROCEDURE TBufStream.Close;
  1357. BEGIN
  1358.    Flush;                                             { Flush the buffer }
  1359.    Inherited Close;                                   { Call ancestor }
  1360. END;
  1361.  
  1362. {--TBufStream---------------------------------------------------------------}
  1363. {  Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                }
  1364. {---------------------------------------------------------------------------}
  1365. PROCEDURE TBufStream.Flush;
  1366. VAR Success: Integer; W: Sw_Word;
  1367. BEGIN
  1368.    If (LastMode=2) AND (BufPtr<>0) Then Begin         { Must update file }
  1369.      If (Handle = -1) Then Success := 103             { File is not open }
  1370.        Else Success := FileWrite(Handle, Buffer^,
  1371.          BufPtr, W);                                  { Write to file }
  1372.      If (Success<>0) OR (W<>BufPtr) Then              { We have an error }
  1373.        If (Success=0) Then Error(stWriteError, 0)     { Unknown write error }
  1374.          Else Error(stError, Success);                { Specific write error }
  1375.    End;
  1376.    BufPtr := 0;                                       { Reset buffer ptr }
  1377.    BufEnd := 0;                                       { Reset buffer end }
  1378. END;
  1379.  
  1380. {--TBufStream---------------------------------------------------------------}
  1381. {  Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB             }
  1382. {---------------------------------------------------------------------------}
  1383. PROCEDURE TBufStream.Truncate;
  1384. BEGIN
  1385.    Flush;                                             { Flush buffer }
  1386.    Inherited Truncate;                                { Truncate file }
  1387. END;
  1388.  
  1389. {--TBufStream---------------------------------------------------------------}
  1390. {  Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                 }
  1391. {---------------------------------------------------------------------------}
  1392. PROCEDURE TBufStream.Seek (Pos: LongInt);
  1393. BEGIN
  1394.    If (Status=stOk) Then Begin                        { Check status okay }
  1395.      If (Position<>Pos) Then Begin                    { Move required }
  1396.        Flush;                                         { Flush the buffer }
  1397.        Inherited Seek(Pos);                           { Call ancestor }
  1398.      End;
  1399.    End;
  1400. END;
  1401.  
  1402. {--TBufStream---------------------------------------------------------------}
  1403. {  Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                 }
  1404. {---------------------------------------------------------------------------}
  1405. PROCEDURE TBufStream.Open (OpenMode: Word);
  1406. BEGIN
  1407.    If (Status=stOk) Then Begin                        { Check status okay }
  1408.      BufPtr := 0;                                     { Clear buffer start }
  1409.      BufEnd := 0;                                     { Clear buffer end }
  1410.      Inherited Open(OpenMode);                        { Call ancestor }
  1411.    End;
  1412. END;
  1413.  
  1414. {--TBufStream---------------------------------------------------------------}
  1415. {  Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                 }
  1416. {---------------------------------------------------------------------------}
  1417. PROCEDURE TBufStream.Read (Var Buf; Count: Sw_Word);
  1418. VAR Success: Integer; W, Bw: Sw_Word; P: PByteArray;
  1419. BEGIN
  1420.    If (Position + Count > StreamSize) Then            { Read pas stream end }
  1421.      Error(stReadError, 0);                           { Call stream error }
  1422.    If (Handle = -1) Then Error(stReadError, 103);     { File not open }
  1423.    P := @Buf;                                         { Transfer address }
  1424.    If (LastMode=2) Then Flush;                        { Flush write buffer }
  1425.    LastMode := 1;                                     { Now set read mode }
  1426.    While (Count>0) AND (Status=stOk) Do Begin         { Check status & count }
  1427.      If (BufPtr=BufEnd) Then Begin                    { Buffer is empty }
  1428.        If (Position + BufSize > StreamSize) Then
  1429.          Bw := StreamSize - Position                  { Amount of file left }
  1430.          Else Bw := BufSize;                          { Full buffer size }
  1431.        Success := FileRead(Handle, Buffer^, Bw, W);   { Read from file }
  1432.        If ((Success<>0) OR (Bw<>W)) Then Begin        { Error was detected }
  1433.        If (Success<>0) Then
  1434.          Error(stReadError, Success)                  { Specific read error }
  1435.          Else Error(stReadError, 0);                  { Non specific error }
  1436.        End Else Begin
  1437.          BufPtr := 0;                                 { Reset BufPtr }
  1438.          BufEnd := W;                                 { End of buffer }
  1439.        End;
  1440.      End;
  1441.      If (Status=stOk) Then Begin                      { Status still okay }
  1442.        W := BufEnd - BufPtr;                          { Space in buffer }
  1443.        If (Count < W) Then W := Count;                { Set transfer size }
  1444.        Move(Buffer^[BufPtr], P^, W);                  { Data from buffer }
  1445.        Dec(Count, W);                                 { Reduce count }
  1446.        Inc(BufPtr, W);                                { Advance buffer ptr }
  1447.        P := Pointer(LongInt(P) + W);                  { Transfer address }
  1448.        Inc(Position, W);                              { Advance position }
  1449.      End;
  1450.    End;
  1451.    If (Status<>stOk) AND (Count>0) Then
  1452.      FillChar(P^, Count, #0);                         { Error clear buffer }
  1453. END;
  1454.  
  1455. {--TBufStream---------------------------------------------------------------}
  1456. {  Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB                }
  1457. {---------------------------------------------------------------------------}
  1458. PROCEDURE TBufStream.Write (Var Buf; Count: Sw_Word);
  1459. VAR Success: Integer; W: Sw_Word; P: PByteArray;
  1460. BEGIN
  1461.    If (Handle = -1) Then Error(stWriteError, 103);    { File not open }
  1462.    If (LastMode=1) Then Flush;                        { Flush read buffer }
  1463.    LastMode := 2;                                     { Now set write mode }
  1464.    P := @Buf;                                         { Transfer address }
  1465.    While (Count>0) AND (Status=stOk) Do Begin         { Check status & count }
  1466.      If (BufPtr=BufSize) Then Begin                   { Buffer is full }
  1467.        Success := FileWrite(Handle, Buffer^, BufSize,
  1468.          W);                                          { Write to file }
  1469.        If (Success<>0) OR (W<>BufSize) Then           { We have an error }
  1470.          If (Success=0) Then Error(stWriteError, 0)   { Unknown write error }
  1471.            Else Error(stError, Success);              { Specific write error }
  1472.        BufPtr := 0;                                   { Reset BufPtr }
  1473.      End;
  1474.      If (Status=stOk) Then Begin                      { Status still okay }
  1475.        W := BufSize - BufPtr;                         { Space in buffer }
  1476.        If (Count < W) Then W := Count;                { Transfer size }
  1477.        Move(P^, Buffer^[BufPtr], W);                  { Data to buffer }
  1478.        Dec(Count, W);                                 { Reduce count }
  1479.        Inc(BufPtr, W);                                { Advance buffer ptr }
  1480.        P := Pointer(LongInt(P) + W);                  { Transfer address }
  1481.        Inc(Position, W);                              { Advance position }
  1482.        If (Position > StreamSize) Then                { File has expanded }
  1483.          StreamSize := Position;                      { Update new size }
  1484.      End;
  1485.    End;
  1486. END;
  1487.  
  1488. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1489. {                        TMemoryStream OBJECT METHODS                       }
  1490. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1491.  
  1492. {--TMemoryStream------------------------------------------------------------}
  1493. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB                 }
  1494. {---------------------------------------------------------------------------}
  1495. CONSTRUCTOR TMemoryStream.Init (ALimit: LongInt; ABlockSize: Word);
  1496. VAR W: Word;
  1497. BEGIN
  1498.    Inherited Init;                                    { Call ancestor }
  1499.    If (ABlockSize=0) Then BlkSize := 8192 Else        { Default blocksize }
  1500.      BlkSize := ABlockSize;                           { Set blocksize }
  1501.    If (ALimit = 0) Then W := 1 Else                   { At least 1 block }
  1502.      W := (ALimit + BlkSize - 1) DIV BlkSize;         { Blocks needed }
  1503.    If NOT ChangeListSize(W) Then                      { Try allocate blocks }
  1504.       Error(stInitError, 0);                          { Initialize error }
  1505. END;
  1506.  
  1507. {--TMemoryStream------------------------------------------------------------}
  1508. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB                 }
  1509. {---------------------------------------------------------------------------}
  1510. DESTRUCTOR TMemoryStream.Done;
  1511. BEGIN
  1512.    ChangeListSize(0);                                 { Release all memory }
  1513.    Inherited Done;                                    { Call ancestor }
  1514. END;
  1515.  
  1516. {--TMemoryStream------------------------------------------------------------}
  1517. {  Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB             }
  1518. {---------------------------------------------------------------------------}
  1519. PROCEDURE TMemoryStream.Truncate;
  1520. VAR W: Word;
  1521. BEGIN
  1522.    If (Status=stOk) Then Begin                        { Check status okay }
  1523.      If (Position = 0) Then W := 1 Else               { At least one block }
  1524.        W := (Position + BlkSize - 1) DIV BlkSize;     { Blocks needed }
  1525.      If ChangeListSize(W) Then StreamSize := Position { Set stream size }
  1526.        Else Error(stError, 0);                        { Error truncating }
  1527.    End;
  1528. END;
  1529.  
  1530. {--TMemoryStream------------------------------------------------------------}
  1531. {  Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB                 }
  1532. {---------------------------------------------------------------------------}
  1533. PROCEDURE TMemoryStream.Read (Var Buf; Count: Sw_Word);
  1534. VAR W, CurBlock, BlockPos: Word; Li: LongInt; P, Q: PByteArray;
  1535. BEGIN
  1536.    If (Position + Count > StreamSize) Then            { Insufficient data }
  1537.      Error(stReadError, 0);                           { Read beyond end!!! }
  1538.    P := @Buf;                                         { Transfer address }
  1539.    While (Count>0) AND (Status=stOk) Do Begin         { Check status & count }
  1540.      CurBlock := Position DIV BlkSize;                { Current block }
  1541.      { * REMARK * - Do not shorten this, result can be > 64K }
  1542.      Li := CurBlock;                                  { Transfer current block }
  1543.      Li := Li * BlkSize;                              { Current position }
  1544.      { * REMARK END * - Leon de Boer }
  1545.      BlockPos := Position - Li;                       { Current position }
  1546.      W := BlkSize - BlockPos;                         { Current block space }
  1547.      If (W > Count) Then W := Count;                  { Adjust read size }
  1548.      Q := Pointer(LongInt(BlkList^[CurBlock]) +
  1549.        BlockPos);                                     { Calc pointer }
  1550.      Move(Q^, P^, W);                                 { Move data to buffer }
  1551.      Inc(Position, W);                                { Adjust position }
  1552.      P := Pointer(LongInt(P) + W);                    { Transfer address }
  1553.      Dec(Count, W);                                   { Adjust count left }
  1554.    End;
  1555.    If (Count<>0) Then FillChar(P^, Count, #0);        { Error clear buffer }
  1556. END;
  1557.  
  1558. {--TMemoryStream------------------------------------------------------------}
  1559. {  Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB                }
  1560. {---------------------------------------------------------------------------}
  1561. PROCEDURE TMemoryStream.Write (Var Buf; Count: Sw_Word);
  1562. VAR W, CurBlock, BlockPos: Word; Li: LongInt; P, Q: PByteArray;
  1563. BEGIN
  1564.    If (Position + Count > MemSize) Then Begin         { Expansion needed }
  1565.      If (Position + Count = 0) Then W := 1 Else       { At least 1 block }
  1566.        W := (Position+Count+BlkSize-1) DIV BlkSize;   { Blocks needed }
  1567.      If NOT ChangeListSize(W) Then
  1568.        Error(stWriteError, 0);                        { Expansion failed!!! }
  1569.    End;
  1570.    P := @Buf;                                         { Transfer address }
  1571.    While (Count>0) AND (Status=stOk) Do Begin         { Check status & count }
  1572.      CurBlock := Position DIV BlkSize;                { Current segment }
  1573.      { * REMARK * - Do not shorten this, result can be > 64K }
  1574.      Li := CurBlock;                                  { Transfer current block }
  1575.      Li := Li * BlkSize;                              { Current position }
  1576.      { * REMARK END * - Leon de Boer }
  1577.      BlockPos := Position - Li;                       { Current position }
  1578.      W := BlkSize - BlockPos;                         { Current block space }
  1579.      If (W > Count) Then W := Count;                  { Adjust write size }
  1580.      Q := Pointer(LongInt(BlkList^[CurBlock]) +
  1581.        BlockPos);                                     { Calc pointer }
  1582.      Move(P^, Q^, W);                                 { Transfer data }
  1583.      Inc(Position, W);                                { Adjust position }
  1584.      P := Pointer(LongInt(P) + W);                    { Transfer address }
  1585.      Dec(Count, W);                                   { Adjust count left }
  1586.      If (Position > StreamSize) Then                  { File expanded }
  1587.        StreamSize := Position;                        { Adjust stream size }
  1588.    End;
  1589. END;
  1590.  
  1591. {***************************************************************************}
  1592. {                      TMemoryStream PRIVATE METHODS                        }
  1593. {***************************************************************************}
  1594.  
  1595. {--TMemoryStream------------------------------------------------------------}
  1596. {  ChangeListSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB       }
  1597. {---------------------------------------------------------------------------}
  1598. FUNCTION TMemoryStream.ChangeListSize (ALimit: Sw_Word): Boolean;
  1599. VAR I, W: Word; Li: LongInt; P: PPointerArray;
  1600. BEGIN
  1601.    If (ALimit <> BlkCount) Then Begin                 { Change is needed }
  1602.      ChangeListSize := False;                         { Preset failure }
  1603.      If (ALimit > MaxPtrs) Then Exit;                 { To many blocks req }
  1604.      If (ALimit <> 0) Then Begin                      { Create segment list }
  1605.        Li := ALimit * SizeOf(Pointer);                { Block array size }
  1606.        If (MaxAvail > Li) Then Begin
  1607.          GetMem(P, Li);                               { Allocate memory }
  1608.          FillChar(P^, Li, #0);                        { Clear the memory }
  1609.        End Else Exit;                                 { Insufficient memory }
  1610.        If (BlkCount <> 0) AND (BlkList <> Nil) Then   { Current list valid }
  1611.          If (BlkCount <= ALimit) Then Move(BlkList^,
  1612.            P^, BlkCount * SizeOf(Pointer)) Else       { Move whole old list }
  1613.            Move(BlkList^, P^, Li);                    { Move partial list }
  1614.      End Else P := Nil;                               { No new block list }
  1615.      If (ALimit < BlkCount) Then                      { Shrink stream size }
  1616.        For W := BlkCount-1 DownTo ALimit Do
  1617.          FreeMem(BlkList^[W], BlkSize);               { Release memory block }
  1618.      If (P <> Nil) AND (ALimit > BlkCount) Then Begin { Expand stream size }
  1619.        For W := BlkCount To ALimit-1 Do Begin
  1620.          If (MaxAvail < BlkSize) Then Begin           { Check enough memory }
  1621.            For I := BlkCount To W-1 Do
  1622.              FreeMem(P^[I], BlkSize);                 { Free mem allocated }
  1623.            FreeMem(P, Li);                            { Release memory }
  1624.            Exit;                                      { Now exit }
  1625.          End Else GetMem(P^[W], BlkSize);             { Allocate memory }
  1626.        End;
  1627.      End;
  1628.      If (BlkCount <> 0) AND (BlkList<>Nil) Then
  1629.        FreeMem(BlkList, BlkCount * SizeOf(Pointer));  { Release old list }
  1630.      BlkList := P;                                    { Hold new block list }
  1631.      BlkCount := ALimit;                              { Hold new count }
  1632.      { * REMARK * - Do not shorten this, result can be > 64K }
  1633.      MemSize := BlkCount;                             { Block count }
  1634.      MemSize := MemSize * BlkSize;                    { Current position }
  1635.      { * REMARK END * - Leon de Boer }
  1636.    End;
  1637.    ChangeListSize := True;                            { Successful }
  1638. END;
  1639.  
  1640.  
  1641. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1642. {                       TCollection OBJECT METHODS                          }
  1643. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1644.  
  1645. {--TCollection--------------------------------------------------------------}
  1646. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1647. {---------------------------------------------------------------------------}
  1648. CONSTRUCTOR TCollection.Init (ALimit, ADelta: Sw_Integer);
  1649. BEGIN
  1650.    Inherited Init;                                    { Call ancestor }
  1651.    Delta := ADelta;                                   { Set increment }
  1652.    SetLimit(ALimit);                                  { Set limit }
  1653. END;
  1654.  
  1655. {--TCollection--------------------------------------------------------------}
  1656. {  Load -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1657. {---------------------------------------------------------------------------}
  1658. CONSTRUCTOR TCollection.Load (Var S: TStream);
  1659. VAR C, I: Sw_Integer;
  1660. BEGIN
  1661.    S.Read(Count, Sizeof(Count));                      { Read count }
  1662.    S.Read(Limit, Sizeof(Limit));                      { Read limit }
  1663.    S.Read(Delta, Sizeof(Delta));                      { Read delta }
  1664.    Items := Nil;                                      { Clear item pointer }
  1665.    C := Count;                                        { Hold count }
  1666.    I := Limit;                                        { Hold limit }
  1667.    Count := 0;                                        { Clear count }
  1668.    Limit := 0;                                        { Clear limit }
  1669.    SetLimit(I);                                       { Set requested limit }
  1670.    Count := C;                                        { Set count }
  1671.    For I := 0 To C-1 Do AtPut(I, GetItem(S));         { Get each item }
  1672. END;
  1673.  
  1674. {--TCollection--------------------------------------------------------------}
  1675. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1676. {---------------------------------------------------------------------------}
  1677. DESTRUCTOR TCollection.Done;
  1678. BEGIN
  1679.    FreeAll;                                           { Free all items }
  1680.    SetLimit(0);                                       { Release all memory }
  1681. END;
  1682.  
  1683. {--TCollection--------------------------------------------------------------}
  1684. {  At -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                   }
  1685. {---------------------------------------------------------------------------}
  1686. FUNCTION TCollection.At (Index: Sw_Integer): Pointer;
  1687. BEGIN
  1688.    If (Index < 0) OR (Index >= Count) Then Begin      { Invalid index }
  1689.      Error(coIndexError, Index);                      { Call error }
  1690.      At := Nil;                                       { Return nil }
  1691.    End Else At := Items^[Index];                      { Return item }
  1692. END;
  1693.  
  1694. {--TCollection--------------------------------------------------------------}
  1695. {  IndexOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  1696. {---------------------------------------------------------------------------}
  1697. FUNCTION TCollection.IndexOf (Item: Pointer): Sw_Integer;
  1698. VAR I: Sw_Integer;
  1699. BEGIN
  1700.    If (Count>0) Then Begin                            { Count is positive }
  1701.      For I := 0 To Count-1 Do                         { For each item }
  1702.        If (Items^[I]=Item) Then Begin                 { Look for match }
  1703.          IndexOf := I;                                { Return index }
  1704.          Exit;                                        { Now exit }
  1705.        End;
  1706.    End;
  1707.    IndexOf := -1;                                     { Return index }
  1708. END;
  1709.  
  1710. {--TCollection--------------------------------------------------------------}
  1711. {  GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  1712. {---------------------------------------------------------------------------}
  1713. FUNCTION TCollection.GetItem (Var S: TStream): Pointer;
  1714. BEGIN
  1715.    GetItem := S.Get;                                  { Item off stream }
  1716. END;
  1717.  
  1718. {--TCollection--------------------------------------------------------------}
  1719. {  LastThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB             }
  1720. {---------------------------------------------------------------------------}
  1721. FUNCTION TCollection.LastThat (Test: Pointer): Pointer;
  1722. VAR I: LongInt; P: FuncPtr; Hold_EBP: Sw_Word;
  1723.  
  1724. BEGIN
  1725.    ASM
  1726.     {$IFDEF CPU86}
  1727.      MOVL (%EBP), %EAX;                               { Load EBP }
  1728.      MOVL %EAX, Hold_EBP;                    { Store to global }
  1729.     {$ENDIF}
  1730.     {$IFDEF CPU68}
  1731.      move.l (a6), d0
  1732.      move.l d0, Hold_EBP
  1733.     {$ENDIF}
  1734.    END;
  1735.    P := FuncPtr(Test);                                { Set function ptr }
  1736.    For I := Count DownTo 1 Do
  1737.      Begin                   { Down from last item }
  1738.        Begin          { Test each item }
  1739.        LastThat := Items^[I-1];                       { Return item }
  1740.        Exit;                                          { Now exit }
  1741.        End;
  1742.      End;
  1743.    LastThat := Nil;                                   { None passed test }
  1744. END;
  1745.  
  1746. {--TCollection--------------------------------------------------------------}
  1747. {  FirstThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB            }
  1748. {---------------------------------------------------------------------------}
  1749. FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
  1750. VAR I: LongInt; P: FuncPtr;  Hold_EBP: Sw_Word;
  1751. BEGIN
  1752.    ASM
  1753.     {$IFDEF CPU86}
  1754.      MOVL (%EBP), %EAX;                               { Load EBP }
  1755.      MOVL %EAX, HOLD_EBP;                             { Store to global }
  1756.     {$ENDIF}
  1757.     {$IFDEF CPU68}
  1758.      move.l (a6), d0
  1759.      move.l d0, Hold_EBP
  1760.     {$ENDIF}
  1761.    END;
  1762.    P := FuncPtr(Test);                                { Set function ptr }
  1763.    For I := 1 To Count Do Begin                       { Up from first item }
  1764.        Begin          { Test each item }
  1765.        FirstThat := Items^[I-1];                      { Return item }
  1766.        Exit;                                          { Now exit }
  1767.      End;
  1768.    End;
  1769.    FirstThat := Nil;                                  { None passed test }
  1770. END;
  1771.  
  1772. {--TCollection--------------------------------------------------------------}
  1773. {  Pack -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1774. {---------------------------------------------------------------------------}
  1775. PROCEDURE TCollection.Pack;
  1776. VAR I, J: Sw_Integer;
  1777. BEGIN
  1778.    I := 0;                                            { Initialize dest }
  1779.    J := 0;                                            { Intialize test }
  1780.    While (I<Count) AND (J<Limit) Do Begin             { Check fully packed }
  1781.      If (Items^[J]<>Nil) Then Begin                   { Found a valid item }
  1782.        If (I<>J) Then Begin
  1783.          Items^[I] := Items^[J];                      { Transfer item }
  1784.          Items^[J] := Nil;                            { Now clear old item }
  1785.        End;
  1786.        Inc(I);                                        { One item packed }
  1787.      End;
  1788.      Inc(J);                                          { Next item to test }
  1789.    End;
  1790.    If (I<Count) Then Count := I;                      { New packed count }
  1791. END;
  1792.  
  1793. {--TCollection--------------------------------------------------------------}
  1794. {  FreeAll -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  1795. {---------------------------------------------------------------------------}
  1796. PROCEDURE TCollection.FreeAll;
  1797. VAR I: Sw_Integer;
  1798. BEGIN
  1799.    For I := 0 To Count-1 Do FreeItem(At(I));          { Release each item }
  1800.    Count := 0;                                        { Clear item count }
  1801. END;
  1802.  
  1803. {--TCollection--------------------------------------------------------------}
  1804. {  DeleteAll -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB            }
  1805. {---------------------------------------------------------------------------}
  1806. PROCEDURE TCollection.DeleteAll;
  1807. BEGIN
  1808.    Count := 0;                                        { Clear item count }
  1809. END;
  1810.  
  1811. {--TCollection--------------------------------------------------------------}
  1812. {  Free -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1813. {---------------------------------------------------------------------------}
  1814. PROCEDURE TCollection.Free (Item: Pointer);
  1815. BEGIN
  1816.    Delete(Item);                                      { Delete from list }
  1817.    FreeItem(Item);                                    { Free the item }
  1818. END;
  1819.  
  1820. {--TCollection--------------------------------------------------------------}
  1821. {  Insert -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB               }
  1822. {---------------------------------------------------------------------------}
  1823. PROCEDURE TCollection.Insert (Item: Pointer);
  1824. BEGIN
  1825.    AtInsert(Count, Item);                             { Insert item }
  1826. END;
  1827.  
  1828. {--TCollection--------------------------------------------------------------}
  1829. {  Delete -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB               }
  1830. {---------------------------------------------------------------------------}
  1831. PROCEDURE TCollection.Delete (Item: Pointer);
  1832. BEGIN
  1833.    AtDelete(IndexOf(Item));                           { Delete from list }
  1834. END;
  1835.  
  1836. {--TCollection--------------------------------------------------------------}
  1837. {  AtFree -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB               }
  1838. {---------------------------------------------------------------------------}
  1839. PROCEDURE TCollection.AtFree (Index: Sw_Integer);
  1840. VAR Item: Pointer;
  1841. BEGIN
  1842.    Item := At(Index);                                 { Retreive item ptr }
  1843.    AtDelete(Index);                                   { Delete item }
  1844.    FreeItem(Item);                                    { Free the item }
  1845. END;
  1846.  
  1847. {--TCollection--------------------------------------------------------------}
  1848. {  FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB             }
  1849. {---------------------------------------------------------------------------}
  1850. PROCEDURE TCollection.FreeItem (Item: Pointer);
  1851. VAR P: PObject;
  1852. BEGIN
  1853.    P := PObject(Item);                                { Convert pointer }
  1854.    If (P<>Nil) Then Dispose(P, Done);                 { Dispose of object }
  1855. END;
  1856.  
  1857. {--TCollection--------------------------------------------------------------}
  1858. {  AtDelete -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB             }
  1859. {---------------------------------------------------------------------------}
  1860. PROCEDURE TCollection.AtDelete (Index: Sw_Integer);
  1861. BEGIN
  1862.    If (Index >= 0) AND (Index < Count) Then Begin     { Valid index }
  1863.      Dec(Count);                                      { One less item }
  1864.      If (Count>Index) Then Move(Items^[Index+1],
  1865.       Items^[Index], (Count-Index)*Sizeof(Pointer));  { Shuffle items down }
  1866.    End Else Error(coIndexError, Index);               { Index error }
  1867. END;
  1868.  
  1869. {--TCollection--------------------------------------------------------------}
  1870. {  ForEach -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  1871. {---------------------------------------------------------------------------}
  1872. PROCEDURE TCollection.ForEach (Action: Pointer);
  1873. VAR I: LongInt; Hold_BP: Sw_Word; P: ProcPtr;
  1874. BEGIN
  1875.    ASM
  1876.    {$IFDEF CPU86}
  1877.      MOVL (%EBP), %EAX;                               { Load EBP }
  1878.      MOVL %EAX, HOLD_BP;                    { Store to global }
  1879.    {$ENDIF}
  1880.    {$IFDEF CPU68}
  1881.      move.l (a6),d0
  1882.      move.l  d0, Hold_BP
  1883.    {$ENDIF}
  1884.    END;
  1885.    P := ProcPtr(Action);                              { Set procedure ptr }
  1886.    For I := 1 To Count Do                             { Up from first item }
  1887.        P(Items^[I-1], Hold_BP);                       { Call with each item }
  1888.  
  1889. END;
  1890.  
  1891. {--TCollection--------------------------------------------------------------}
  1892. {  SetLimit -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB             }
  1893. {---------------------------------------------------------------------------}
  1894. PROCEDURE TCollection.SetLimit (ALimit: Sw_Integer);
  1895. VAR AItems: PItemList;
  1896. BEGIN
  1897.    If (ALimit < Count) Then ALimit := Count;          { Stop underflow }
  1898.    If (ALimit > MaxCollectionSize) Then
  1899.      ALimit := MaxCollectionSize;                     { Stop overflow }
  1900.    If (ALimit <> Limit) Then Begin                    { Limits differ }
  1901.      If (ALimit = 0) Then AItems := Nil Else Begin    { Alimit=0 nil entry }
  1902.        GetMem(AItems, ALimit * SizeOf(Pointer));      { Allocate memory }
  1903.        If (AItems<>Nil) Then FillChar(AItems^,
  1904.          ALimit * SizeOf(Pointer), #0);               { Clear the memory }
  1905.      End;
  1906.      If (AItems<>Nil) OR (ALimit=0) Then Begin        { Check success }
  1907.        If (AItems <>Nil) AND (Items <> Nil) Then      { Check both valid }
  1908.          Move(Items^, AItems^, Count*SizeOf(Pointer));{ Move existing items }
  1909.        If (Limit <> 0) AND (Items <> Nil) Then        { Check old allocation }
  1910.          FreeMem(Items, Limit * SizeOf(Pointer));     { Release memory }
  1911.        Items := AItems;                               { Update items }
  1912.        Limit := ALimit;                               { Set limits }
  1913.      End;
  1914.    End;
  1915. END;
  1916.  
  1917. {--TCollection--------------------------------------------------------------}
  1918. {  Error -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                }
  1919. {---------------------------------------------------------------------------}
  1920. PROCEDURE TCollection.Error (Code, Info: Integer);
  1921. BEGIN
  1922.    RunError(212 - Code);                              { Run error }
  1923. END;
  1924.  
  1925. {--TCollection--------------------------------------------------------------}
  1926. {  AtPut -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                }
  1927. {---------------------------------------------------------------------------}
  1928. PROCEDURE TCollection.AtPut (Index: Sw_Integer; Item: Pointer);
  1929. BEGIN
  1930.    If (Index >= 0) AND (Index < Count) Then           { Index valid }
  1931.      Items^[Index] := Item                            { Put item in index }
  1932.      Else Error(coIndexError, Index);                 { Index error }
  1933. END;
  1934.  
  1935. {--TCollection--------------------------------------------------------------}
  1936. {  AtInsert -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB             }
  1937. {---------------------------------------------------------------------------}
  1938. PROCEDURE TCollection.AtInsert (Index: Sw_Integer; Item: Pointer);
  1939. VAR I: Sw_Integer;
  1940. BEGIN
  1941.    If (Index >= 0) AND (Index <= Count) Then Begin    { Valid index }
  1942.      If (Count=Limit) Then SetLimit(Limit+Delta);     { Expand size if able }
  1943.      If (Limit>Count) Then Begin
  1944.        If (Index < Count) Then Begin                  { Not last item }
  1945.          For I := Count DownTo Index Do               { Start from back }
  1946.            Items^[I] := Items^[I-1];                  { Move each item }
  1947.        End;
  1948.        Items^[Index] := Item;                         { Put item in list }
  1949.        Inc(Count);                                    { Inc count }
  1950.      End Else Error(coOverflow, Index);               { Expand failed }
  1951.    End Else Error(coIndexError, Index);               { Index error }
  1952. END;
  1953.  
  1954. {--TCollection--------------------------------------------------------------}
  1955. {  Store -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                }
  1956. {---------------------------------------------------------------------------}
  1957. PROCEDURE TCollection.Store (Var S: TStream);
  1958.  
  1959.    PROCEDURE DoPutItem (P: Pointer);{$IFNDEF FPC}FAR;{$ENDIF}
  1960.    BEGIN
  1961.      PutItem(S, P);                                   { Put item on stream }
  1962.    END;
  1963.  
  1964. BEGIN
  1965.    S.Write(Count, Sizeof(Count));                     { Write count }
  1966.    S.Write(Limit, Sizeof(Limit));                     { Write limit }
  1967.    S.Write(Delta, Sizeof(Delta));                     { Write delta }
  1968.    ForEach(@DoPutItem);                               { Each item to stream }
  1969. END;
  1970.  
  1971. {--TCollection--------------------------------------------------------------}
  1972. {  PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  1973. {---------------------------------------------------------------------------}
  1974. PROCEDURE TCollection.PutItem (Var S: TStream; Item: Pointer);
  1975. BEGIN
  1976.    S.Put(Item);                                       { Put item on stream }
  1977. END;
  1978.  
  1979. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1980. {                       TSortedCollection OBJECT METHODS                    }
  1981. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1982.  
  1983. {--TSortedCollection--------------------------------------------------------}
  1984. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1985. {---------------------------------------------------------------------------}
  1986. CONSTRUCTOR TSortedCollection.Init (ALimit, ADelta: Sw_Integer);
  1987. BEGIN
  1988.    Inherited Init(ALimit, ADelta);                    { Call ancestor }
  1989.    Duplicates := False;                               { Clear flag }
  1990. END;
  1991.  
  1992. {--TSortedCollection--------------------------------------------------------}
  1993. {  Load -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                 }
  1994. {---------------------------------------------------------------------------}
  1995. CONSTRUCTOR TSortedCollection.Load (Var S: TStream);
  1996. BEGIN
  1997.    Inherited Load(S);                                 { Call ancestor }
  1998.    S.Read(Duplicates, SizeOf(Duplicates));            { Read duplicate flag }
  1999. END;
  2000.  
  2001. {--TSortedCollection--------------------------------------------------------}
  2002. {  KeyOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                }
  2003. {---------------------------------------------------------------------------}
  2004. FUNCTION TSortedCollection.KeyOf (Item: Pointer): Pointer;
  2005. BEGIN
  2006.    KeyOf := Item;                                     { Return item as key }
  2007. END;
  2008.  
  2009. {--TSortedCollection--------------------------------------------------------}
  2010. {  IndexOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  2011. {---------------------------------------------------------------------------}
  2012. FUNCTION TSortedCollection.IndexOf (Item: Pointer): Sw_Integer;
  2013. VAR I, J: Sw_Integer;
  2014. BEGIN
  2015.    J := -1;                                           { Preset result }
  2016.    If Search(KeyOf(Item), I) Then Begin               { Search for item }
  2017.      If Duplicates Then                               { Duplicates allowed }
  2018.        While (I < Count) AND (Item <> Items^[I]) Do
  2019.          Inc(I);                                      { Count duplicates }
  2020.      If (I < Count) Then J := I;                      { Index result }
  2021.    End;
  2022.    IndexOf := J;                                      { Return result }
  2023. END;
  2024.  
  2025. {--TSortedCollection--------------------------------------------------------}
  2026. {  Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  2027. {---------------------------------------------------------------------------}
  2028. FUNCTION TSortedCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  2029. BEGIN
  2030.    Abstract;                                          { Abstract method }
  2031.    Compare:=0;
  2032. END;
  2033.  
  2034. {--TSortedCollection--------------------------------------------------------}
  2035. {  Search -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB               }
  2036. {---------------------------------------------------------------------------}
  2037. FUNCTION TSortedCollection.Search (Key: Pointer; Var Index: Sw_Integer): Boolean;
  2038. VAR L, H, I, C: Sw_Integer;
  2039. BEGIN
  2040.    Search := False;                                   { Preset failure }
  2041.    L := 0;                                            { Start count }
  2042.    H := Count - 1;                                    { End count }
  2043.    While (L <= H) Do Begin
  2044.      I := (L + H) SHR 1;                              { Mid point }
  2045.      C := Compare(KeyOf(Items^[I]), Key);             { Compare with key }
  2046.      If (C < 0) Then L := I + 1 Else Begin            { Item to left }
  2047.        H := I - 1;                                    { Item to right }
  2048.        If C = 0 Then Begin                            { Item match found }
  2049.          Search := True;                              { Result true }
  2050.          If NOT Duplicates Then L := I;               { Force kick out }
  2051.        End;
  2052.      End;
  2053.    End;
  2054.    Index := L;                                        { Return result }
  2055. END;
  2056.  
  2057. {--TSortedCollection--------------------------------------------------------}
  2058. {  Insert -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB               }
  2059. {---------------------------------------------------------------------------}
  2060. PROCEDURE TSortedCollection.Insert (Item: Pointer);
  2061. VAR I: Sw_Integer;
  2062. BEGIN
  2063.    If NOT Search(KeyOf(Item), I) OR Duplicates Then   { Item valid }
  2064.      AtInsert(I, Item);                               { Insert the item }
  2065. END;
  2066.  
  2067. {--TSortedCollection--------------------------------------------------------}
  2068. {  Store -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB                }
  2069. {---------------------------------------------------------------------------}
  2070. PROCEDURE TSortedCollection.Store (Var S: TStream);
  2071. BEGIN
  2072.    TCollection.Store(S);                              { Call ancestor }
  2073.    S.Write(Duplicates, SizeOf(Duplicates));           { Write duplicate flag }
  2074. END;
  2075.  
  2076. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2077. {                     TStringCollection OBJECT METHODS                      }
  2078. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2079.  
  2080. {--TStringCollection--------------------------------------------------------}
  2081. {  GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  2082. {---------------------------------------------------------------------------}
  2083. FUNCTION TStringCollection.GetItem (Var S: TStream): Pointer;
  2084. BEGIN
  2085.    GetItem := S.ReadStr;                              { Get new item }
  2086. END;
  2087.  
  2088. {--TStringCollection--------------------------------------------------------}
  2089. {  Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 21Aug97 LdB              }
  2090. {---------------------------------------------------------------------------}
  2091. FUNCTION TStringCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  2092. VAR I, J: Integer; P1, P2: PString;
  2093. BEGIN
  2094.    P1 := PString(Key1);                               { String 1 pointer }
  2095.    P2 := PString(Key2);                               { String 2 pointer }
  2096.    If (Length(P1^)<Length(P2^)) Then J := Length(P1^)
  2097.      Else J := Length(P2^);                           { Shortest length }
  2098.    I := 1;                                            { First character }
  2099.    While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I);         { Scan till fail }
  2100.    If (I=J) Then Begin                                { Possible match }
  2101.    { * REMARK * - Bug fix   21 August 1997 }
  2102.      If (P1^[I]<P2^[I]) Then Compare := -1 Else       { String1 < String2 }
  2103.        If (P1^[I]>P2^[I]) Then Compare := 1 Else      { String1 > String2 }
  2104.        If (Length(P1^)>Length(P2^)) Then Compare := 1 { String1 > String2 }
  2105.          Else If (Length(P1^)<Length(P2^)) Then       { String1 < String2 }
  2106.            Compare := -1 Else Compare := 0;           { String1 = String2 }
  2107.    { * REMARK END * - Leon de Boer }
  2108.    End Else If (P1^[I]<P2^[I]) Then Compare := -1     { String1 < String2 }
  2109.      Else Compare := 1;                               { String1 > String2 }
  2110. END;
  2111.  
  2112. {--TStringCollection--------------------------------------------------------}
  2113. {  FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB             }
  2114. {---------------------------------------------------------------------------}
  2115. PROCEDURE TStringCollection.FreeItem (Item: Pointer);
  2116. BEGIN
  2117.    DisposeStr(Item);                                  { Dispose item }
  2118. END;
  2119.  
  2120. {--TStringCollection--------------------------------------------------------}
  2121. {  PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB              }
  2122. {---------------------------------------------------------------------------}
  2123. PROCEDURE TStringCollection.PutItem (Var S: TStream; Item: Pointer);
  2124. BEGIN
  2125.    S.WriteStr(Item);                                  { Write string }
  2126. END;
  2127.  
  2128. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2129. {                       TStrCollection OBJECT METHODS                       }
  2130. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2131.  
  2132. {--TStrCollection-----------------------------------------------------------}
  2133. {  Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB              }
  2134. {---------------------------------------------------------------------------}
  2135. FUNCTION TStrCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  2136. VAR I, J: Sw_Integer; P1, P2: PByteArray;
  2137. BEGIN
  2138.    P1 := PByteArray(Key1);                            { PChar 1 pointer }
  2139.    P2 := PByteArray(Key2);                            { PChar 2 pointer }
  2140.    I := 0;                                            { Preset no size }
  2141.    If (P1<>Nil) Then While (P1^[I]<>0) Do Inc(I);     { PChar 1 length }
  2142.    J := 0;                                            { Preset no size }
  2143.    If (P2<>Nil) Then While (P2^[J]<>0) Do Inc(J);     { PChar 2 length }
  2144.    If (I < J) Then J := I;                            { Shortest length }
  2145.    I := 0;                                            { First character }
  2146.    While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I);         { Scan till fail }
  2147.    If (P1^[I]=P2^[I]) Then Compare := 0 Else          { Strings matched }
  2148.      If (P1^[I]<P2^[I]) Then Compare := -1 Else       { String1 < String2 }
  2149.         Compare := 1;                                 { String1 > String2 }
  2150. END;
  2151.  
  2152. {--TStrCollection-----------------------------------------------------------}
  2153. {  GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB              }
  2154. {---------------------------------------------------------------------------}
  2155. FUNCTION TStrCollection.GetItem (Var S: TStream): Pointer;
  2156. BEGIN
  2157.    GetItem := S.StrRead;                              { Get string item }
  2158. END;
  2159.  
  2160. {--TStrCollection-----------------------------------------------------------}
  2161. {  FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB             }
  2162. {---------------------------------------------------------------------------}
  2163. PROCEDURE TStrCollection.FreeItem (Item: Pointer);
  2164. VAR I: Sw_Integer; P: PByteArray;
  2165. BEGIN
  2166.    If (Item<>Nil) Then Begin                          { Item is valid }
  2167.      P := PByteArray(Item);                           { Create byte pointer }
  2168.      I := 0;                                          { Preset no size }
  2169.      While (P^[I]<>0) Do Inc(I);                      { Find PChar end }
  2170.      FreeMem(Item, I+1);                              { Release memory }
  2171.    End;
  2172. END;
  2173.  
  2174. {--TStrCollection-----------------------------------------------------------}
  2175. {  PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB              }
  2176. {---------------------------------------------------------------------------}
  2177. PROCEDURE TStrCollection.PutItem (Var S: TStream; Item: Pointer);
  2178. BEGIN
  2179.    S.StrWrite(Item);                                  { Write the string }
  2180. END;
  2181.  
  2182. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2183. {                   TUnSortedStrCollection OBJECT METHODS                   }
  2184. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2185.  
  2186. {--TUnSortedCollection------------------------------------------------------}
  2187. {  Insert -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB               }
  2188. {---------------------------------------------------------------------------}
  2189. PROCEDURE TUnSortedStrCollection.Insert (Item: Pointer);
  2190. BEGIN
  2191.    AtInsert(Count, Item);                             { Insert - NO sorting }
  2192. END;
  2193.  
  2194. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2195. {                           TResourceItem RECORD                            }
  2196. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2197. TYPE
  2198.    TResourceItem = RECORD
  2199.       Posn: LongInt;                                  { Resource position }
  2200.       Size: LongInt;                                  { Resource size }
  2201.       Key : String;                                   { Resource key }
  2202.    End;
  2203.    PResourceItem = ^TResourceItem;
  2204.  
  2205. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2206. {                    TResourceCollection OBJECT METHODS                     }
  2207. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2208.  
  2209. {--TResourceCollection------------------------------------------------------}
  2210. {  KeyOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB                }
  2211. {---------------------------------------------------------------------------}
  2212. FUNCTION TResourceCollection.KeyOf (Item: Pointer): Pointer;
  2213. BEGIN
  2214.    KeyOf := @PResourceItem(Item)^.Key;                { Pointer to key }
  2215. END;
  2216.  
  2217. {--TResourceCollection------------------------------------------------------}
  2218. {  GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB              }
  2219. {---------------------------------------------------------------------------}
  2220. FUNCTION TResourceCollection.GetItem (Var S: TStream): Pointer;
  2221. VAR B: Byte; Pos: Longint; Size: Longint; Ts: String; P: PResourceItem;
  2222. BEGIN
  2223.    S.Read(Pos, SizeOf(Pos));                          { Read position }
  2224.    S.Read(Size, SizeOf(Size));                        { Read size }
  2225.    S.Read(B, 1);                                      { Read key length }
  2226.    GetMem(P, B + (SizeOf(TResourceItem) -
  2227.      SizeOf(Ts) + 1));                                { Allocate min memory }
  2228.    If (P<>Nil) Then Begin                             { If allocate works }
  2229.      P^.Posn := Pos;                                  { Xfer position }
  2230.      P^.Size := Size;                                 { Xfer size }
  2231.      P^.Key[0] := Char(B);                            { Xfer string length }
  2232.      S.Read(P^.Key[1], B);                            { Xfer string data }
  2233.    End;
  2234.    GetItem := P;                                      { Return pointer }
  2235. END;
  2236.  
  2237. {--TResourceCollection------------------------------------------------------}
  2238. {  FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB             }
  2239. {---------------------------------------------------------------------------}
  2240. PROCEDURE TResourceCollection.FreeItem (Item: Pointer);
  2241. VAR Ts: String;
  2242. BEGIN
  2243.    If (Item<>Nil) Then FreeMem(Item,
  2244.      SizeOf(TResourceItem) - SizeOf(Ts) +
  2245.      Length(PResourceItem(Item)^.Key) + 1);           { Release memory }
  2246. END;
  2247.  
  2248. {--TResourceCollection------------------------------------------------------}
  2249. {  PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB              }
  2250. {---------------------------------------------------------------------------}
  2251. PROCEDURE TResourceCollection.PutItem (Var S: TStream; Item: Pointer);
  2252. VAR Ts: String;
  2253. BEGIN
  2254.    If (Item<>Nil) Then S.Write(PResourceItem(Item)^,
  2255.     SizeOf(TResourceItem) - SizeOf(Ts) +
  2256.     Length(PResourceItem(Item)^.Key) + 1);            { Write to stream }
  2257. END;
  2258.  
  2259. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2260. {                  PRIVATE RESOURCE MANAGER CONSTANTS                       }
  2261. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2262. CONST
  2263.    RStreamMagic: LongInt = $52504246;                 { 'FBPR' }
  2264.    RStreamBackLink: LongInt = $4C424246;              { 'FBBL' }
  2265.  
  2266. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2267. {                    PRIVATE RESOURCE MANAGER TYPES                         }
  2268. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2269. TYPE
  2270. {$IFDEF NewExeFormat}                                 { New EXE format }
  2271.    TExeHeader = RECORD
  2272.      eHdrSize:   Word;
  2273.      eMinAbove:  Word;
  2274.      eMaxAbove:  Word;
  2275.      eInitSS:    Word;
  2276.      eInitSP:    Word;
  2277.      eCheckSum:  Word;
  2278.      eInitPC:    Word;
  2279.      eInitCS:    Word;
  2280.      eRelocOfs:  Word;
  2281.      eOvlyNum:   Word;
  2282.      eRelocTab:  Word;
  2283.      eSpace:     Array[1..30] of Byte;
  2284.      eNewHeader: Word;
  2285.    END;
  2286. {$ENDIF}
  2287.  
  2288.    THeader = RECORD
  2289.      Signature: Word;
  2290.      Case Integer Of
  2291.        0: (
  2292.          LastCount: Word;
  2293.          PageCount: Word;
  2294.          ReloCount: Word);
  2295.        1: (
  2296.          InfoType: Word;
  2297.          InfoSize: Longint);
  2298.    End;
  2299.  
  2300. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2301. {                       TResourceFile OBJECT METHODS                        }
  2302. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2303.  
  2304. {--TResourceFile------------------------------------------------------------}
  2305. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                 }
  2306. {---------------------------------------------------------------------------}
  2307. CONSTRUCTOR TResourceFile.Init(AStream: PStream);
  2308. VAR Found, Stop: Boolean; Header: THeader;
  2309.     {$IFDEF NewExeFormat} ExeHeader: TExeHeader; {$ENDIF}
  2310. BEGIN
  2311.    TObject.Init;                                      { Initialize object }
  2312.    Found := False;                                    { Preset false }
  2313.    If (Stream<>Nil) Then Begin
  2314.      Stream := AStream;                               { Hold stream }
  2315.      BasePos := Stream^.GetPos;                       { Get position }
  2316.      Repeat
  2317.        Stop := True;                                  { Preset stop }
  2318.        If (BasePos <= Stream^.GetSize-SizeOf(THeader))
  2319.        Then Begin                                     { Valid file header }
  2320.          Stream^.Seek(BasePos);                       { Seek to position }
  2321.          Stream^.Read(Header, SizeOf(THeader));       { Read header }
  2322.          Case Header.Signature Of
  2323.          {$IFDEF NewExeFormat}                        { New format file }
  2324.            $5A4D: Begin
  2325.              Stream^.Read(ExeHeader, SizeOf(TExeHeader));
  2326.              BasePos := ExeHeader.eNewHeader;         { Hold position }
  2327.              Stop := False;                           { Clear stop flag }
  2328.            End;
  2329.            $454E: Begin
  2330.              BasePos := Stream^.GetSize - 8;          { Hold position }
  2331.              Stop := False;                           { Clear stop flag }
  2332.            End;
  2333.            $4246: Begin
  2334.              Stop := False;                           { Clear stop flag }
  2335.              Case Header.Infotype Of
  2336.                $5250: Begin                           { Found Resource }
  2337.                    Found := True;                     { Found flag is true }
  2338.                    Stop := True;                      { Set stop flag }
  2339.                  End;
  2340.                $4C42: Dec(BasePos, Header.InfoSize-8);{ Found BackLink }
  2341.                $4648: Dec(BasePos, SizeOf(THeader)*2);{ Found HelpFile }
  2342.                Else Stop := True;                     { Set stop flag }
  2343.              End;
  2344.            End;
  2345.            $424E: If Header.InfoType = $3230          { Found Debug Info }
  2346.            Then Begin
  2347.              Dec(BasePos, Header.InfoSize);           { Adjust position }
  2348.              Stop := False;                           { Clear stop flag }
  2349.            End;
  2350.          {$ELSE}
  2351.            $5A4D: Begin
  2352.              Inc(BasePos, LongInt(Header.PageCount)*512
  2353.                - (-Header.LastCount AND 511));        { Calc position }
  2354.              Stop := False;                           { Clear stop flag }
  2355.            End;
  2356.            $4246: If Header.InfoType = $5250 Then     { Header was found }
  2357.              Found := True Else Begin
  2358.                Inc(BasePos, Header.InfoSize + 8);     { Adjust position }
  2359.                Stop := False;                         { Clear stop flag }
  2360.              End;
  2361.          {$ENDIF}
  2362.          End;
  2363.        End;
  2364.      Until Stop;                                      { Until flag is set }
  2365.    End;
  2366.    If Found Then Begin                                { Resource was found }
  2367.      Stream^.Seek(BasePos + SizeOf(LongInt) * 2);     { Seek to position }
  2368.      Stream^.Read(IndexPos, SizeOf(LongInt));         { Read index position }
  2369.      Stream^.Seek(BasePos + IndexPos);                { Seek to resource }
  2370.      Index.Load(Stream^);                             { Load resource }
  2371.    End Else Begin
  2372.      IndexPos := SizeOf(LongInt) * 3;                 { Set index position }
  2373.      Index.Init(0, 8);                                { Set index }
  2374.    End;
  2375. END;
  2376.  
  2377. {--TResourceFile------------------------------------------------------------}
  2378. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                 }
  2379. {---------------------------------------------------------------------------}
  2380. DESTRUCTOR TResourceFile.Done;
  2381. BEGIN
  2382.    Flush;                                             { Flush the file }
  2383.    Index.Done;                                        { Dispose of index }
  2384.    If (Stream<>Nil) Then Dispose(Stream, Done);       { Dispose of stream }
  2385. END;
  2386.  
  2387. {--TResourceFile------------------------------------------------------------}
  2388. {  Count -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                }
  2389. {---------------------------------------------------------------------------}
  2390. FUNCTION TResourceFile.Count: Sw_Integer;
  2391. BEGIN
  2392.    Count := Index.Count;                              { Return index count }
  2393. END;
  2394.  
  2395. {--TResourceFile------------------------------------------------------------}
  2396. {  KeyAt -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                }
  2397. {---------------------------------------------------------------------------}
  2398. FUNCTION TResourceFile.KeyAt (I: Sw_Integer): String;
  2399. BEGIN
  2400.    KeyAt := PResourceItem(Index.At(I))^.Key;          { Return key }
  2401. END;
  2402.  
  2403. {--TResourceFile------------------------------------------------------------}
  2404. {  Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                  }
  2405. {---------------------------------------------------------------------------}
  2406. FUNCTION TResourceFile.Get (Key: String): PObject;
  2407. VAR I: Sw_Integer;
  2408. BEGIN
  2409.    If (Stream = Nil) OR (NOT Index.Search(@Key, I))   { No match on key }
  2410.    Then Get := Nil Else Begin
  2411.      Stream^.Seek(BasePos +
  2412.        PResourceItem(Index.At(I))^.Posn);             { Seek to position }
  2413.      Get := Stream^.Get;                              { Get item }
  2414.    End;
  2415. END;
  2416.  
  2417. {--TResourceFile------------------------------------------------------------}
  2418. {  SwitchTo -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB             }
  2419. {---------------------------------------------------------------------------}
  2420. FUNCTION TResourceFile.SwitchTo (AStream: PStream; Pack: Boolean): PStream;
  2421. VAR NewBasePos: LongInt;
  2422.  
  2423.    PROCEDURE DoCopyResource (Item: PResourceItem);{$IFNDEF FPC}FAR;{$ENDIF}
  2424.    BEGIN
  2425.      Stream^.Seek(BasePos + Item^.Posn);              { Move stream position }
  2426.      Item^.Posn := AStream^.GetPos - NewBasePos;      { Hold new position }
  2427.      AStream^.CopyFrom(Stream^, Item^.Size);          { Copy the item }
  2428.    END;
  2429.  
  2430. BEGIN
  2431.    SwitchTo := Stream;                                { Preset return }
  2432.    If (AStream<>Nil) AND (Stream<>Nil) Then Begin     { Both streams valid }
  2433.      NewBasePos := AStream^.GetPos;                   { Get position }
  2434.      If Pack Then Begin
  2435.        AStream^.Seek(NewBasePos + SizeOf(LongInt)*3); { Seek to position }
  2436.        Index.ForEach(@DoCopyResource);                { Copy each resource }
  2437.        IndexPos := AStream^.GetPos - NewBasePos;      { Hold index position }
  2438.      End Else Begin
  2439.        Stream^.Seek(BasePos);                         { Seek to position }
  2440.        AStream^.CopyFrom(Stream^, IndexPos);          { Copy the resource }
  2441.      End;
  2442.      Stream := AStream;                               { Hold new stream }
  2443.      BasePos := NewBasePos;                           { New base position }
  2444.      Modified := True;                                { Set modified flag }
  2445.    End;
  2446. END;
  2447.  
  2448. {--TResourceFile------------------------------------------------------------}
  2449. {  Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                }
  2450. {---------------------------------------------------------------------------}
  2451. PROCEDURE TResourceFile.Flush;
  2452. VAR ResSize: LongInt; LinkSize: LongInt;
  2453. BEGIN
  2454.    If (Modified) AND (Stream<>Nil) Then Begin         { We have modification }
  2455.      Stream^.Seek(BasePos + IndexPos);                { Seek to position }
  2456.      Index.Store(Stream^);                            { Store the item }
  2457.      ResSize := Stream^.GetPos - BasePos;             { Hold position }
  2458.      LinkSize := ResSize + SizeOf(LongInt) * 2;       { Hold link size }
  2459.      Stream^.Write(RStreamBackLink, SizeOf(LongInt)); { Write link back }
  2460.      Stream^.Write(LinkSize, SizeOf(LongInt));        { Write link size }
  2461.      Stream^.Seek(BasePos);                           { Move stream position }
  2462.      Stream^.Write(RStreamMagic, SizeOf(LongInt));    { Write number }
  2463.      Stream^.Write(ResSize, SizeOf(LongInt));         { Write record size }
  2464.      Stream^.Write(IndexPos, SizeOf(LongInt));        { Write index position }
  2465.      Stream^.Flush;                                   { Flush the stream }
  2466.    End;
  2467.    Modified := False;                                 { Clear modified flag }
  2468. END;
  2469.  
  2470. {--TResourceFile------------------------------------------------------------}
  2471. {  Delete -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB               }
  2472. {---------------------------------------------------------------------------}
  2473. PROCEDURE TResourceFile.Delete (Key: String);
  2474. VAR I: Sw_Integer;
  2475. BEGIN
  2476.    If Index.Search(@Key, I) Then Begin                { Search for key }
  2477.      Index.Free(Index.At(I));                         { Delete from index }
  2478.      Modified := True;                                { Set modified flag }
  2479.    End;
  2480. END;
  2481.  
  2482. {--TResourceFile------------------------------------------------------------}
  2483. {  Put -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB                  }
  2484. {---------------------------------------------------------------------------}
  2485. PROCEDURE TResourceFile.Put (Item: PObject; Key: String);
  2486. VAR I: Sw_Integer; Ts: String; P: PResourceItem;
  2487. BEGIN
  2488.    If (Stream=Nil) Then Exit;                         { Stream not valid }
  2489.    If Index.Search(@Key, I) Then P := Index.At(I)     { Search for item }
  2490.    Else Begin
  2491.      GetMem(P, Length(Key) + (SizeOf(TResourceItem) -
  2492.        SizeOf(Ts) + 1));                              { Allocate memory }
  2493.      If (P<>Nil) Then Begin
  2494.        P^.Key := Key;                                 { Store key }
  2495.        Index.AtInsert(I, P);                          { Insert item }
  2496.      End;
  2497.    End;
  2498.    If (P<>Nil) Then Begin
  2499.      P^.Posn := IndexPos;                             { Set index position }
  2500.      Stream^.Seek(BasePos + IndexPos);                { Seek file position }
  2501.      Stream^.Put(Item);                               { Put item on stream }
  2502.      IndexPos := Stream^.GetPos - BasePos;            { Hold index position }
  2503.      P^.Size := IndexPos - P^.Posn;                   { Calc size }
  2504.      Modified := True;                                { Set modified flag }
  2505.    End;
  2506. END;
  2507.  
  2508. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2509. {                          TStringList OBJECT METHODS                       }
  2510. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2511.  
  2512. {--TStringList--------------------------------------------------------------}
  2513. {  Load -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                 }
  2514. {---------------------------------------------------------------------------}
  2515. CONSTRUCTOR TStringList.Load (Var S: TStream);
  2516. VAR Size: Word;
  2517. BEGIN
  2518.    Stream := @S;                                      { Hold stream pointer }
  2519.    S.Read(Size, SizeOf(Word));                        { Read size }
  2520.    BasePos := S.GetPos;                               { Hold position }
  2521.    S.Seek(BasePos + Size);                            { Seek to position }
  2522.    S.Read(IndexSize, SizeOf(Integer));                { Read index size }
  2523.    GetMem(Index, IndexSize * SizeOf(TStrIndexRec));   { Allocate memory }
  2524.    S.Read(Index^, IndexSize * SizeOf(TStrIndexRec));  { Read indexes }
  2525. END;
  2526.  
  2527. {--TStringList--------------------------------------------------------------}
  2528. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                 }
  2529. {---------------------------------------------------------------------------}
  2530. DESTRUCTOR TStringList.Done;
  2531. BEGIN
  2532.    FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));  { Release memory }
  2533. END;
  2534.  
  2535. {--TStringList--------------------------------------------------------------}
  2536. {  Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                  }
  2537. {---------------------------------------------------------------------------}
  2538. FUNCTION TStringList.Get (Key: Sw_Word): String;
  2539. VAR I: Word; S: String;
  2540. BEGIN
  2541.    S := '';                                           { Preset empty string }
  2542.    If (IndexSize>0) Then Begin                        { We must have strings }
  2543.      I := 0;                                          { First entry }
  2544.      While (I<IndexSize) AND (S='') Do Begin
  2545.        If ((Key - Index^[I].Key)<Index^[I].Count)     { Diff less than count }
  2546.          Then ReadStr(S, Index^[I].Offset,
  2547.            Key-Index^[I].Key);                        { Read the string }
  2548.        Inc(I);                                        { Next entry }
  2549.      End;
  2550.    End;
  2551.    Get := S;                                          { Return empty string }
  2552. END;
  2553.  
  2554. {***************************************************************************}
  2555. {                       TStringList PRIVATE METHODS                         }
  2556. {***************************************************************************}
  2557.  
  2558. {--TStringLis---------------------------------------------------------------}
  2559. {  ReadStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB              }
  2560. {---------------------------------------------------------------------------}
  2561. PROCEDURE TStringList.ReadStr (Var S: String; Offset, Skip: Sw_Word);
  2562. BEGIN
  2563.    Stream^.Seek(BasePos + Offset);                    { Seek to position }
  2564.    Inc(Skip);                                         { Adjust skip }
  2565.    Repeat
  2566.      Stream^.Read(S[0], 1);                           { Read string size }
  2567.      Stream^.Read(S[1], Ord(S[0]));                   { Read string data }
  2568.      Dec(Skip);                                       { One string read }
  2569.    Until (Skip = 0);
  2570. END;
  2571.  
  2572. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2573. {                         TStrListMaker OBJECT METHODS                      }
  2574. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2575.  
  2576. {--TStrListMaker------------------------------------------------------------}
  2577. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                 }
  2578. {---------------------------------------------------------------------------}
  2579. CONSTRUCTOR TStrListMaker.Init (AStrSize, AIndexSize: Sw_Word);
  2580. BEGIN
  2581.    Inherited Init;                                    { Call ancestor }
  2582.    StrSize := AStrSize;                               { Hold size }
  2583.    IndexSize := AIndexSize;                           { Hold index size }
  2584.    GetMem(Strings, AStrSize);                         { Allocate memory }
  2585.    GetMem(Index, AIndexSize * SizeOf(TStrIndexRec));  { Allocate memory }
  2586. END;
  2587.  
  2588. {--TStrListMaker------------------------------------------------------------}
  2589. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                 }
  2590. {---------------------------------------------------------------------------}
  2591. DESTRUCTOR TStrListMaker.Done;
  2592. BEGIN
  2593.    FreeMem(Index, IndexSize * SizeOf(TStrIndexRec));  { Free index memory }
  2594.    FreeMem(Strings, StrSize);                         { Free data memory }
  2595. END;
  2596.  
  2597. {--TStrListMaker------------------------------------------------------------}
  2598. {  Put -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                  }
  2599. {---------------------------------------------------------------------------}
  2600. PROCEDURE TStrListMaker.Put (Key: Sw_Word; S: String);
  2601. BEGIN
  2602.    If (Cur.Count = 16) OR (Key <> Cur.Key + Cur.Count)
  2603.      Then CloseCurrent;                               { Close current }
  2604.    If (Cur.Count = 0) Then Begin
  2605.      Cur.Key := Key;                                  { Set key }
  2606.      Cur.Offset := StrPos;                            { Set offset }
  2607.    End;
  2608.    Inc(Cur.Count);                                    { Inc count }
  2609.    Move(S, Strings^[StrPos], Length(S) + 1);          { Move string data }
  2610.    Inc(StrPos, Length(S) + 1);                        { Adjust position }
  2611. END;
  2612.  
  2613. {--TStrListMaker------------------------------------------------------------}
  2614. {  Store -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB                }
  2615. {---------------------------------------------------------------------------}
  2616. PROCEDURE TStrListMaker.Store (Var S: TStream);
  2617. BEGIN
  2618.    CloseCurrent;                                      { Close all current }
  2619.    S.Write(StrPos, SizeOf(Word));                     { Write position }
  2620.    S.Write(Strings^, StrPos);                         { Write string data }
  2621.    S.Write(IndexPos, SizeOf(Word));                   { Write index position }
  2622.    S.Write(Index^, IndexPos * SizeOf(TStrIndexRec));  { Write indexes }
  2623. END;
  2624.  
  2625. {***************************************************************************}
  2626. {                      TStrListMaker PRIVATE METHODS                        }
  2627. {***************************************************************************}
  2628.  
  2629. {--TStrListMaker------------------------------------------------------------}
  2630. {  CloseCurrent -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB         }
  2631. {---------------------------------------------------------------------------}
  2632. PROCEDURE TStrListMaker.CloseCurrent;
  2633. BEGIN
  2634.    If (Cur.Count <> 0) Then Begin
  2635.      Index^[IndexPos] := Cur;                         { Hold index position }
  2636.      Inc(IndexPos);                                   { Next index }
  2637.      Cur.Count := 0;                                  { Adjust count }
  2638.    End;
  2639. END;
  2640.  
  2641. {***************************************************************************}
  2642. {                            INTERFACE ROUTINES                             }
  2643. {***************************************************************************}
  2644.  
  2645. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2646. {                    DYNAMIC STRING INTERFACE ROUTINES                      }
  2647. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2648.  
  2649. {---------------------------------------------------------------------------}
  2650. {  NewStr -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB           }
  2651. {---------------------------------------------------------------------------}
  2652. FUNCTION NewStr (Const S: String): PString;
  2653. VAR P: PString;
  2654. BEGIN
  2655.    If (S = '') Then P := Nil Else Begin               { Return nil }
  2656.      GetMem(P, Length(S) + 1);                        { Allocate memory }
  2657.      If (P<>Nil) Then P^ := S;                        { Hold string }
  2658.    End;
  2659.    NewStr := P;                                       { Return result }
  2660. END;
  2661.  
  2662. {---------------------------------------------------------------------------}
  2663. {  DisposeStr -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB       }
  2664. {---------------------------------------------------------------------------}
  2665. PROCEDURE DisposeStr (P: PString);
  2666. BEGIN
  2667.    If (P <> Nil) Then FreeMem(P, Length(P^) + 1);     { Release memory }
  2668. END;
  2669.  
  2670. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2671. {                        STREAM INTERFACE ROUTINES                          }
  2672. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2673.  
  2674. {---------------------------------------------------------------------------}
  2675. {  Abstract -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB         }
  2676. {---------------------------------------------------------------------------}
  2677. PROCEDURE Abstract;
  2678. BEGIN
  2679.    RunError(211);                                     { Abstract error }
  2680. END;
  2681.  
  2682. {---------------------------------------------------------------------------}
  2683. {  RegisterObjects -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 02Sep97 LdB  }
  2684. {---------------------------------------------------------------------------}
  2685. PROCEDURE RegisterObjects;
  2686. BEGIN
  2687. { ******************************* REMARK ****************************** }
  2688. {    FPK 0.92 compiler wont handle this section OFS seems not to be a   }
  2689. {  defined function which we need -> Function Ofs(X): LongInt; So for   }
  2690. {  now we must exclude these and in the RegisterObjects code.           }
  2691. { ****************************** END REMARK *** Leon de Boer, 04Sep97 * }
  2692. {   RegisterType(RCollection);       }                  { Register object }
  2693. {   RegisterType(RStringCollection); }                  { Register object }
  2694. {   RegisterType(RStrCollection);    }                  { Register object }
  2695. END;
  2696.  
  2697. {---------------------------------------------------------------------------}
  2698. {  RegisterType -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 02Sep97 LdB     }
  2699. {---------------------------------------------------------------------------}
  2700. PROCEDURE RegisterType (Var S: TStreamRec);
  2701. VAR P: PStreamRec;
  2702. BEGIN
  2703.    P := StreamTypes;                                  { Current reg list }
  2704.    While (P <> Nil) AND (P^.ObjType <> S.ObjType)
  2705.      Do P := P^.Next;                                 { Find end of chain }
  2706.    If (P = Nil) AND (S.ObjType <> 0) Then Begin       { Valid end found }
  2707.      S.Next := StreamTypes;                           { Chain the list }
  2708.      StreamTypes := @S;                               { We are now first }
  2709.    End Else RegisterError;                            { Register the error }
  2710. END;
  2711.  
  2712. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2713. {                    GENERAL FUNCTION INTERFACE ROUTINES                    }
  2714. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2715.  
  2716. {---------------------------------------------------------------------------}
  2717. {  LongMul -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 04Sep97 LdB          }
  2718. {---------------------------------------------------------------------------}
  2719. FUNCTION LongMul (X, Y: Integer): LongInt;
  2720.   BEGIN
  2721.     LongMul:=Longint(X*Y);
  2722.   END;
  2723. {---------------------------------------------------------------------------}
  2724. {  LongDiv -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 04Sep97 LdB          }
  2725. {---------------------------------------------------------------------------}
  2726. FUNCTION LongDiv (X: LongInt; Y: Integer): Integer;
  2727. BEGIN
  2728.   LongDiv := Integer(X DIV Y);
  2729. END;
  2730.  
  2731.  
  2732. END.
  2733. {
  2734.   $Log: objects.pp,v $
  2735.   Revision 1.7  1998/07/15 12:08:33  carl
  2736.     + Atari TOS support
  2737.  
  2738.   Revision 1.6  1998/07/08 12:00:25  carl
  2739.     * fixed problem with m68k asm syntax
  2740.     * i386_att put back in, and only in cpu86 defined
  2741.  
  2742.   Revision 1.4  1998/05/30 14:24:42  peter
  2743.     * ATT asmparsing always
  2744.  
  2745.   Revision 1.3  1998/05/25 09:50:04  peter
  2746.     * Platform.inc -> platform.inc
  2747.  
  2748.   Revision 1.2  1998/05/21 19:30:58  peter
  2749.     * objects compiles for linux
  2750.     + assign(pchar), assign(char), rename(pchar), rename(char)
  2751.     * fixed read_text_as_array
  2752.     + read_text_as_pchar which was not yet in the rtl
  2753.  
  2754. }
  2755.